1 {***********************************************************
2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
5 modified by Delphi OpenGL Community (http://delphigl.com/)
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 ------------------------------------------------------------
16 ------------------------------------------------------------
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)
25 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
26 - Additional Datapointer for functioninterface now has the name CustomData
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)
35 - RLE TGAs loaded much faster
37 - fixed some problem with reading RLE TGAs.
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.
42 - It's possible to set the id of the texture
43 - define GLB_NO_NATIVE_GL deactivated by default
45 - Now supports the following libraries
49 - Linux compatibillity via free pascal compatibility (delphi sources optional)
50 - BMPs now loaded manuel
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
57 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
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
63 - pngimage now disabled by default like all other versions.
65 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
67 - Fixed some Problem with Delphi 5
68 - Now uses the newest version of pngimage. Makes saving pngs much easier.
70 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
72 - Internal Format ifDepth8 added
73 - function GrabScreen now supports all uncompressed formats
75 - AddAlphaFromglBitmap implemented
77 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
79 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
80 property Width, Height, Depth are still existing and new property Dimension are avail
82 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
84 - Added function GrabScreen to class TglBitmap2D
86 - Added support to Save images
87 - Added function Clone to Clone Instance
89 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
91 - Several speed optimizations
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
98 - Added Support to decompress DXT3 and DXT5 compressed Images.
99 - Added Mapping to convert data from one format into an other.
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
106 - Added Support for compressed DDSs
107 - Added new internal formats (DXT1, DXT3, DXT5)
109 - Parameter Components renamed to InternalFormat
111 - Some AllocMem replaced with GetMem (little speed change)
112 - better exception handling. Better protection from memory leaks.
114 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
115 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
117 - Added support for Grayscale textures
118 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
120 - Added support for GL_VERSION_2_0
121 - Added support for GL_EXT_texture_filter_anisotropic
123 - Function FillWithColor fills the Image with one Color
124 - Function LoadNormalMap added
126 - ToNormalMap allows to Create an NormalMap from the Alphachannel
127 - ToNormalMap now supports Sobel (nmSobel) function.
129 - support for RLE Compressed RGB TGAs added
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)
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
139 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
141 - little enhancement for IsPowerOfTwo
142 - TglBitmap1D.GenTexture now tests NPOT Textures
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.
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.
150 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
152 - Function Unbind added
153 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
155 - class TglBitmapCubeMap added (allows to Create Cubemaps)
157 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
158 To Enable png's use the define pngimage
160 - New Functioninterface added
161 - Function GetPixel added
163 - Property BuildMipMaps renamed to MipMap
165 - property Name removed.
166 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
168 - property name added. Only used in glForms!
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)
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
182 - TglBitmap dosn't delete data if class was destroyed (fixed)
184 - Bind now enables TextureUnits (by params)
185 - GenTextures can leave data (by param)
186 - LoadTextures now optimal
188 - Performance optimization in AddFunc
189 - procedure Bind moved to subclasses
190 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
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
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
205 - Added function FlipHorz
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
211 - Added Alphafunctions to calculate alpha per function
212 - Added Alpha from ColorKey using alphafunctions
214 - First full functionally Version of glBitmap
215 - Support for 24Bit and 32Bit TGA Pictures added
217 - begin of programming
218 ***********************************************************}
221 // Please uncomment the defines below to configure the glBitmap to your preferences.
222 // If you have configured the unit you can uncomment the warning above.
223 {$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
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}
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}
237 // activate to enable the support for SDL_surfaces
240 // activate to enable the support for TBitmap from Delphi (not lazarus)
241 {.$DEFINE GLB_DELPHI}
243 // activate to enable the support for TLazIntfImage from Lazarus
244 {$DEFINE GLB_LAZARUS}
247 // activate to enable the support of SDL_image to load files. (READ ONLY)
248 // If you enable SDL_image all other libraries will be ignored!
249 {.$DEFINE GLB_SDL_IMAGE}
253 // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
254 // if you enable pngimage the libPNG will be ignored
255 {.$DEFINE GLB_PNGIMAGE}
257 // activate to use the libPNG -> http://www.libpng.org/
258 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
259 {.$DEFINE GLB_LIB_PNG}
263 // if you enable delphi jpegs the libJPEG will be ignored
264 {.$DEFINE GLB_DELPHI_JPEG}
266 // activate to use the libJPEG -> http://www.ijg.org/
267 // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
268 {.$DEFINE GLB_LIB_JPEG}
271 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
272 // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
273 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
289 {$IF DEFINED(WIN32) or DEFINED(WIN64)}
291 {$ELSEIF DEFINED(LINUX)}
295 // native OpenGL Support
296 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
297 {$DEFINE GLB_NATIVE_OGL}
300 // checking define combinations
302 {$IFDEF GLB_SDL_IMAGE}
304 {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
307 {$IFDEF GLB_PNGIMAGE}
308 {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
309 {$undef GLB_PNGIMAGE}
311 {$IFDEF GLB_DELPHI_JPEG}
312 {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
313 {$undef GLB_DELPHI_JPEG}
316 {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
319 {$IFDEF GLB_LIB_JPEG}
320 {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
321 {$undef GLB_LIB_JPEG}
324 {$DEFINE GLB_SUPPORT_PNG_READ}
325 {$DEFINE GLB_SUPPORT_JPEG_READ}
329 {$IFDEF GLB_PNGIMAGE}
331 {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
335 {$DEFINE GLB_SUPPORT_PNG_READ}
336 {$DEFINE GLB_SUPPORT_PNG_WRITE}
341 {$DEFINE GLB_SUPPORT_PNG_READ}
342 {$DEFINE GLB_SUPPORT_PNG_WRITE}
346 {$IFDEF GLB_DELPHI_JPEG}
347 {$IFDEF GLB_LIB_JPEG}
348 {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
349 {$undef GLB_LIB_JPEG}
352 {$DEFINE GLB_SUPPORT_JPEG_READ}
353 {$DEFINE GLB_SUPPORT_JPEG_WRITE}
357 {$IFDEF GLB_LIB_JPEG}
358 {$DEFINE GLB_SUPPORT_JPEG_READ}
359 {$DEFINE GLB_SUPPORT_JPEG_WRITE}
363 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
364 {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
378 {$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
379 {$IF DEFINED(GLB_WIN) AND
380 DEFINED(GLB_NATIVE_OGL)} windows, {$ENDIF}
382 {$IFDEF GLB_SDL} SDL, {$ENDIF}
383 {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, {$ENDIF}
384 {$IFDEF GLB_DELPHI} Dialogs, Graphics, {$ENDIF}
386 {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
388 {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
389 {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
391 {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
392 {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
402 TRGBQuad = packed record
410 {$IFDEF GLB_NATIVE_OGL}
416 GL_EXTENSIONS = $1F03;
418 GL_TEXTURE_1D = $0DE0;
419 GL_TEXTURE_2D = $0DE1;
420 GL_TEXTURE_RECTANGLE = $84F5;
422 GL_TEXTURE_WIDTH = $1000;
423 GL_TEXTURE_HEIGHT = $1001;
424 GL_TEXTURE_INTERNAL_FORMAT = $1003;
432 GL_LUMINANCE = $1909;
433 GL_LUMINANCE4 = $803F;
434 GL_LUMINANCE8 = $8040;
435 GL_LUMINANCE12 = $8041;
436 GL_LUMINANCE16 = $8042;
438 GL_LUMINANCE_ALPHA = $190A;
439 GL_LUMINANCE4_ALPHA4 = $8043;
440 GL_LUMINANCE6_ALPHA2 = $8044;
441 GL_LUMINANCE8_ALPHA8 = $8045;
442 GL_LUMINANCE12_ALPHA4 = $8046;
443 GL_LUMINANCE12_ALPHA12 = $8047;
444 GL_LUMINANCE16_ALPHA16 = $8048;
467 GL_DEPTH_COMPONENT = $1902;
468 GL_DEPTH_COMPONENT16 = $81A5;
469 GL_DEPTH_COMPONENT24 = $81A6;
470 GL_DEPTH_COMPONENT32 = $81A7;
472 GL_COMPRESSED_RGB = $84ED;
473 GL_COMPRESSED_RGBA = $84EE;
474 GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
475 GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
476 GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
477 GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
479 GL_UNSIGNED_BYTE = $1401;
480 GL_UNSIGNED_BYTE_3_3_2 = $8032;
481 GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
483 GL_UNSIGNED_SHORT = $1403;
484 GL_UNSIGNED_SHORT_5_6_5 = $8363;
485 GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
486 GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
487 GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
488 GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
489 GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
491 GL_UNSIGNED_INT = $1405;
492 GL_UNSIGNED_INT_8_8_8_8 = $8035;
493 GL_UNSIGNED_INT_10_10_10_2 = $8036;
494 GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
495 GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
498 GL_TEXTURE_MAG_FILTER = $2800;
499 GL_TEXTURE_MIN_FILTER = $2801;
501 GL_NEAREST_MIPMAP_NEAREST = $2700;
502 GL_NEAREST_MIPMAP_LINEAR = $2702;
504 GL_LINEAR_MIPMAP_NEAREST = $2701;
505 GL_LINEAR_MIPMAP_LINEAR = $2703;
508 GL_TEXTURE_WRAP_S = $2802;
509 GL_TEXTURE_WRAP_T = $2803;
510 GL_TEXTURE_WRAP_R = $8072;
513 GL_CLAMP_TO_EDGE = $812F;
514 GL_CLAMP_TO_BORDER = $812D;
515 GL_MIRRORED_REPEAT = $8370;
518 GL_GENERATE_MIPMAP = $8191;
519 GL_TEXTURE_BORDER_COLOR = $1004;
520 GL_MAX_TEXTURE_SIZE = $0D33;
521 GL_PACK_ALIGNMENT = $0D05;
522 GL_UNPACK_ALIGNMENT = $0CF5;
524 GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
525 GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
528 libglu = 'libGLU.so.1';
529 libopengl = 'libGL.so.1';
531 libglu = 'glu32.dll';
532 libopengl = 'opengl32.dll';
536 GLboolean = BYTEBOOL;
544 PGLboolean = ^GLboolean;
549 TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
550 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}
551 TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
553 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
554 TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
555 TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
557 TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
558 TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
560 TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
561 TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
562 TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
563 TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
564 TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
565 TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
567 TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
568 TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
569 TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
571 TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
572 TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
573 TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
575 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}
576 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}
577 TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
579 TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
580 TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
583 TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
584 TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
586 TwglGetProcAddress = function(ProcName: PAnsiChar): Pointer; stdcall;
589 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
590 procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
591 procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
593 function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
594 procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
596 procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
597 procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
598 procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
599 procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
600 procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
601 procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
603 procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
604 procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
605 procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
607 function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
608 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;
609 procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
611 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;
612 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;
613 procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
615 function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
616 function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
625 GL_SGIS_generate_mipmap,
627 GL_ARB_texture_border_clamp,
628 GL_ARB_texture_mirrored_repeat,
629 GL_ARB_texture_rectangle,
630 GL_ARB_texture_non_power_of_two,
632 GL_IBM_texture_mirrored_repeat,
634 GL_NV_texture_rectangle,
636 GL_EXT_texture_edge_clamp,
637 GL_EXT_texture_rectangle,
638 GL_EXT_texture_filter_anisotropic: Boolean;
640 glCompressedTexImage1D: TglCompressedTexImage1D;
641 glCompressedTexImage2D: TglCompressedTexImage2D;
642 glGetCompressedTexImage: TglGetCompressedTexImage;
644 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
646 glDisable: TglDisable;
648 glGetString: TglGetString;
649 glGetIntegerv: TglGetIntegerv;
651 glTexParameteri: TglTexParameteri;
652 glTexParameterfv: TglTexParameterfv;
653 glGetTexParameteriv: TglGetTexParameteriv;
654 glGetTexParameterfv: TglGetTexParameterfv;
655 glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
656 glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
658 glGenTextures: TglGenTextures;
659 glBindTexture: TglBindTexture;
660 glDeleteTextures: TglDeleteTextures;
662 glAreTexturesResident: TglAreTexturesResident;
663 glReadPixels: TglReadPixels;
664 glPixelStorei: TglPixelStorei;
666 glTexImage1D: TglTexImage1D;
667 glTexImage2D: TglTexImage2D;
668 glGetTexImage: TglGetTexImage;
670 gluBuild1DMipmaps: TgluBuild1DMipmaps;
671 gluBuild2DMipmaps: TgluBuild2DMipmaps;
673 {$IF DEFINED(GLB_WIN)}
674 wglGetProcAddress: TwglGetProcAddress;
675 {$ELSEIF DEFINED(GLB_LINUX)}
676 glXGetProcAddress: TglXGetProcAddress;
677 glXGetProcAddressARB: TglXGetProcAddressARB;
691 ////////////////////////////////////////////////////////////////////////////////////////////////////
693 tfEmpty = 0, //must be smallest value!
709 tfLuminance12Alpha12,
710 tfLuminance16Alpha16,
754 TglBitmapFileType = (
755 {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
756 {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
760 TglBitmapFileTypes = set of TglBitmapFileType;
767 TglBitmapNormalMapFunc = (
773 ////////////////////////////////////////////////////////////////////////////////////////////////////
774 EglBitmapException = class(Exception);
775 EglBitmapSizeToLargeException = class(EglBitmapException);
776 EglBitmapNonPowerOfTwoException = class(EglBitmapException);
777 EglBitmapUnsupportedFormat = class(EglBitmapException)
778 constructor Create(const aFormat: TglBitmapFormat); overload;
779 constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
782 ////////////////////////////////////////////////////////////////////////////////////////////////////
783 TglBitmapColorRec = packed record
785 0: (r, g, b, a: Cardinal);
786 1: (arr: array[0..3] of Cardinal);
789 TglBitmapPixelData = packed record
790 Data, Range: TglBitmapColorRec;
791 Format: TglBitmapFormat;
793 PglBitmapPixelData = ^TglBitmapPixelData;
795 ////////////////////////////////////////////////////////////////////////////////////////////////////
796 TglBitmapPixelPositionFields = set of (ffX, ffY);
797 TglBitmapPixelPosition = record
798 Fields : TglBitmapPixelPositionFields;
803 ////////////////////////////////////////////////////////////////////////////////////////////////////
805 TglBitmapFunctionRec = record
807 Size: TglBitmapPixelPosition;
808 Position: TglBitmapPixelPosition;
809 Source: TglBitmapPixelData;
810 Dest: TglBitmapPixelData;
813 TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
815 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
820 fAnisotropic: Integer;
821 fDeleteTextureOnFree: Boolean;
822 fFreeDataAfterGenTexture: Boolean;
824 fIsResident: Boolean;
825 fBorderColor: array[0..3] of Single;
827 fDimension: TglBitmapPixelPosition;
828 fMipMap: TglBitmapMipMap;
829 fFormat: TglBitmapFormat;
836 fFilterMin: Cardinal;
837 fFilterMag: Cardinal;
847 fCustomNameW: WideString;
848 fCustomData: Pointer;
851 function GetWidth: Integer; virtual;
852 function GetHeight: Integer; virtual;
854 function GetFileWidth: Integer; virtual;
855 function GetFileHeight: Integer; virtual;
858 procedure SetCustomData(const aValue: Pointer);
859 procedure SetCustomName(const aValue: String);
860 procedure SetCustomNameW(const aValue: WideString);
861 procedure SetDeleteTextureOnFree(const aValue: Boolean);
862 procedure SetFormat(const aValue: TglBitmapFormat);
863 procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
864 procedure SetID(const aValue: Cardinal);
865 procedure SetMipMap(const aValue: TglBitmapMipMap);
866 procedure SetTarget(const aValue: Cardinal);
867 procedure SetAnisotropic(const aValue: Integer);
870 procedure SetupParameters(out aBuildWithGlu: Boolean);
871 procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
872 const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
873 procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
875 function FlipHorz: Boolean; virtual;
876 function FlipVert: Boolean; virtual;
878 property Width: Integer read GetWidth;
879 property Height: Integer read GetHeight;
881 property FileWidth: Integer read GetFileWidth;
882 property FileHeight: Integer read GetFileHeight;
885 property ID: Cardinal read fID write SetID;
886 property Target: Cardinal read fTarget write SetTarget;
887 property Format: TglBitmapFormat read fFormat write SetFormat;
888 property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
889 property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
891 property Filename: String read fFilename;
892 property CustomName: String read fCustomName write SetCustomName;
893 property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
894 property CustomData: Pointer read fCustomData write SetCustomData;
896 property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
897 property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
899 property Dimension: TglBitmapPixelPosition read fDimension;
900 property Data: PByte read fData;
901 property IsResident: Boolean read fIsResident;
903 procedure AfterConstruction; override;
904 procedure BeforeDestruction; override;
906 procedure PrepareResType(var aResource: String; var aResType: PChar);
909 procedure LoadFromFile(const aFilename: String);
910 procedure LoadFromStream(const aStream: TStream); virtual;
911 procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
912 const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
913 procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
914 procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
917 procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
918 procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
921 function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
922 function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
923 const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
927 function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
928 function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
929 function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
930 function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
931 const aArgs: Pointer = nil): Boolean;
935 function AssignToBitmap(const aBitmap: TBitmap): Boolean;
936 function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
937 function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
938 function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
939 const aArgs: Pointer = nil): Boolean;
943 function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
944 function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
945 function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
946 function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
947 const aArgs: Pointer = nil): Boolean;
950 function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
951 const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
952 function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
953 const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
955 function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
956 function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
957 function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
958 function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
960 function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
961 function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
962 function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
964 function AddAlphaFromValue(const aAlpha: Byte): Boolean;
965 function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
966 function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
968 function RemoveAlpha: Boolean; virtual;
971 function Clone: TglBitmap;
972 function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
973 procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
974 procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
978 procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
979 procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
980 procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
983 procedure SetFilter(const aMin, aMag: Cardinal);
985 const S: Cardinal = GL_CLAMP_TO_EDGE;
986 const T: Cardinal = GL_CLAMP_TO_EDGE;
987 const R: Cardinal = GL_CLAMP_TO_EDGE);
989 procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
990 procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
993 constructor Create; overload;
994 constructor Create(const aFileName: String); overload;
995 constructor Create(const aStream: TStream); overload;
996 constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
997 constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
998 constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
999 constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
1001 {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1002 {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
1004 {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
1005 {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
1007 function LoadBMP(const aStream: TStream): Boolean; virtual;
1008 procedure SaveBMP(const aStream: TStream); virtual;
1010 function LoadTGA(const aStream: TStream): Boolean; virtual;
1011 procedure SaveTGA(const aStream: TStream); virtual;
1013 function LoadDDS(const aStream: TStream): Boolean; virtual;
1014 procedure SaveDDS(const aStream: TStream); virtual;
1017 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1018 TglBitmap2D = class(TglBitmap)
1020 // Bildeinstellungen
1021 fLines: array of PByte;
1023 function GetScanline(const aIndex: Integer): Pointer;
1024 procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
1025 const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1026 procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
1030 property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1032 procedure AfterConstruction; override;
1034 procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1035 procedure GetDataFromTexture;
1036 procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1038 function FlipHorz: Boolean; override;
1039 function FlipVert: Boolean; override;
1041 procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1042 const aScale: Single = 2; const aUseAlpha: Boolean = false);
1046 TglBitmapCubeMap = class(TglBitmap2D)
1051 procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
1053 procedure AfterConstruction; override;
1055 procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
1057 procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
1058 procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
1062 TglBitmapNormalMap = class(TglBitmapCubeMap)
1064 procedure AfterConstruction; override;
1066 procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
1070 TglBitmap1D = class(TglBitmap)
1072 procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1074 procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
1075 procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
1080 procedure AfterConstruction; override;
1083 function FlipHorz: Boolean; override;
1086 procedure GenTexture(TestTextureSize: Boolean = true); override;
1091 NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1093 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1094 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1095 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1096 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1097 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1098 procedure glBitmapSetDefaultWrap(
1099 const S: Cardinal = GL_CLAMP_TO_EDGE;
1100 const T: Cardinal = GL_CLAMP_TO_EDGE;
1101 const R: Cardinal = GL_CLAMP_TO_EDGE);
1103 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1104 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1105 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1106 function glBitmapGetDefaultFormat: TglBitmapFormat;
1107 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1108 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1110 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1111 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1112 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1115 glBitmapDefaultDeleteTextureOnFree: Boolean;
1116 glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1117 glBitmapDefaultFormat: TglBitmapFormat;
1118 glBitmapDefaultMipmap: TglBitmapMipMap;
1119 glBitmapDefaultFilterMin: Cardinal;
1120 glBitmapDefaultFilterMag: Cardinal;
1121 glBitmapDefaultWrapS: Cardinal;
1122 glBitmapDefaultWrapT: Cardinal;
1123 glBitmapDefaultWrapR: Cardinal;
1126 function CreateGrayPalette: HPALETTE;
1132 Math, syncobjs, typinfo;
1135 ////////////////////////////////////////////////////////////////////////////////////////////////////
1136 TShiftRec = packed record
1138 0: (r, g, b, a: Byte);
1139 1: (arr: array[0..3] of Byte);
1142 TFormatDescriptor = class(TObject)
1144 function GetRedMask: QWord;
1145 function GetGreenMask: QWord;
1146 function GetBlueMask: QWord;
1147 function GetAlphaMask: QWord;
1149 fFormat: TglBitmapFormat;
1150 fWithAlpha: TglBitmapFormat;
1151 fWithoutAlpha: TglBitmapFormat;
1152 fRGBInverted: TglBitmapFormat;
1153 fUncompressed: TglBitmapFormat;
1155 fIsCompressed: Boolean;
1157 fRange: TglBitmapColorRec;
1160 fglFormat: Cardinal;
1161 fglInternalFormat: Cardinal;
1162 fglDataFormat: Cardinal;
1164 function GetComponents: Integer; virtual;
1166 property Format: TglBitmapFormat read fFormat;
1167 property WithAlpha: TglBitmapFormat read fWithAlpha;
1168 property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1169 property RGBInverted: TglBitmapFormat read fRGBInverted;
1170 property Components: Integer read GetComponents;
1171 property PixelSize: Single read fPixelSize;
1172 property IsCompressed: Boolean read fIsCompressed;
1174 property glFormat: Cardinal read fglFormat;
1175 property glInternalFormat: Cardinal read fglInternalFormat;
1176 property glDataFormat: Cardinal read fglDataFormat;
1178 property Range: TglBitmapColorRec read fRange;
1179 property Shift: TShiftRec read fShift;
1181 property RedMask: QWord read GetRedMask;
1182 property GreenMask: QWord read GetGreenMask;
1183 property BlueMask: QWord read GetBlueMask;
1184 property AlphaMask: QWord read GetAlphaMask;
1186 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1187 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1189 function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
1190 function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
1192 function CreateMappingData: Pointer; virtual;
1193 procedure FreeMappingData(var aMappingData: Pointer); virtual;
1195 function IsEmpty: Boolean; virtual;
1196 function HasAlpha: Boolean; virtual;
1197 function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1199 procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1201 constructor Create; virtual;
1203 class procedure Init;
1204 class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1205 class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1206 class procedure Clear;
1207 class procedure Finalize;
1209 TFormatDescriptorClass = class of TFormatDescriptor;
1211 TfdEmpty = class(TFormatDescriptor);
1213 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1214 TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1215 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1216 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1217 constructor Create; override;
1220 TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1221 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1222 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1223 constructor Create; override;
1226 TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1227 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1228 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1229 constructor Create; override;
1232 TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1233 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1234 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1235 constructor Create; override;
1238 TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1239 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1240 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1241 constructor Create; override;
1244 TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1245 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1246 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1247 constructor Create; override;
1250 TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1251 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1252 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1253 constructor Create; override;
1256 TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
1257 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1258 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1259 constructor Create; override;
1262 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1263 TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1264 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1265 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1266 constructor Create; override;
1269 TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1270 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1271 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1272 constructor Create; override;
1275 TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1276 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1277 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1278 constructor Create; override;
1281 TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1282 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1283 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1284 constructor Create; override;
1287 TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1288 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1289 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1290 constructor Create; override;
1293 TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1294 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1295 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1296 constructor Create; override;
1299 TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1300 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1301 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1302 constructor Create; override;
1305 TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1306 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1307 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1308 constructor Create; override;
1311 TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1312 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1313 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1314 constructor Create; override;
1317 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1318 TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1319 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1320 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1321 constructor Create; override;
1324 TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1325 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1326 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1327 constructor Create; override;
1330 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1331 TfdAlpha4 = class(TfdAlpha_UB1)
1332 constructor Create; override;
1335 TfdAlpha8 = class(TfdAlpha_UB1)
1336 constructor Create; override;
1339 TfdAlpha12 = class(TfdAlpha_US1)
1340 constructor Create; override;
1343 TfdAlpha16 = class(TfdAlpha_US1)
1344 constructor Create; override;
1347 TfdLuminance4 = class(TfdLuminance_UB1)
1348 constructor Create; override;
1351 TfdLuminance8 = class(TfdLuminance_UB1)
1352 constructor Create; override;
1355 TfdLuminance12 = class(TfdLuminance_US1)
1356 constructor Create; override;
1359 TfdLuminance16 = class(TfdLuminance_US1)
1360 constructor Create; override;
1363 TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1364 constructor Create; override;
1367 TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1368 constructor Create; override;
1371 TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1372 constructor Create; override;
1375 TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1376 constructor Create; override;
1379 TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1380 constructor Create; override;
1383 TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1384 constructor Create; override;
1387 TfdR3G3B2 = class(TfdUniversal_UB1)
1388 constructor Create; override;
1391 TfdRGB4 = class(TfdUniversal_US1)
1392 constructor Create; override;
1395 TfdR5G6B5 = class(TfdUniversal_US1)
1396 constructor Create; override;
1399 TfdRGB5 = class(TfdUniversal_US1)
1400 constructor Create; override;
1403 TfdRGB8 = class(TfdRGB_UB3)
1404 constructor Create; override;
1407 TfdRGB10 = class(TfdUniversal_UI1)
1408 constructor Create; override;
1411 TfdRGB12 = class(TfdRGB_US3)
1412 constructor Create; override;
1415 TfdRGB16 = class(TfdRGB_US3)
1416 constructor Create; override;
1419 TfdRGBA2 = class(TfdRGBA_UB4)
1420 constructor Create; override;
1423 TfdRGBA4 = class(TfdUniversal_US1)
1424 constructor Create; override;
1427 TfdRGB5A1 = class(TfdUniversal_US1)
1428 constructor Create; override;
1431 TfdRGBA8 = class(TfdRGBA_UB4)
1432 constructor Create; override;
1435 TfdRGB10A2 = class(TfdUniversal_UI1)
1436 constructor Create; override;
1439 TfdRGBA12 = class(TfdRGBA_US4)
1440 constructor Create; override;
1443 TfdRGBA16 = class(TfdRGBA_US4)
1444 constructor Create; override;
1447 TfdBGR4 = class(TfdUniversal_US1)
1448 constructor Create; override;
1451 TfdB5G6R5 = class(TfdUniversal_US1)
1452 constructor Create; override;
1455 TfdBGR5 = class(TfdUniversal_US1)
1456 constructor Create; override;
1459 TfdBGR8 = class(TfdBGR_UB3)
1460 constructor Create; override;
1463 TfdBGR10 = class(TfdUniversal_UI1)
1464 constructor Create; override;
1467 TfdBGR12 = class(TfdBGR_US3)
1468 constructor Create; override;
1471 TfdBGR16 = class(TfdBGR_US3)
1472 constructor Create; override;
1475 TfdBGRA2 = class(TfdBGRA_UB4)
1476 constructor Create; override;
1479 TfdBGRA4 = class(TfdUniversal_US1)
1480 constructor Create; override;
1483 TfdBGR5A1 = class(TfdUniversal_US1)
1484 constructor Create; override;
1487 TfdBGRA8 = class(TfdBGRA_UB4)
1488 constructor Create; override;
1491 TfdBGR10A2 = class(TfdUniversal_UI1)
1492 constructor Create; override;
1495 TfdBGRA12 = class(TfdBGRA_US4)
1496 constructor Create; override;
1499 TfdBGRA16 = class(TfdBGRA_US4)
1500 constructor Create; override;
1503 TfdDepth16 = class(TfdDepth_US1)
1504 constructor Create; override;
1507 TfdDepth24 = class(TfdDepth_UI1)
1508 constructor Create; override;
1511 TfdDepth32 = class(TfdDepth_UI1)
1512 constructor Create; override;
1515 TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1516 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1517 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1518 constructor Create; override;
1521 TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1522 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1523 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1524 constructor Create; override;
1527 TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1528 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1529 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1530 constructor Create; override;
1533 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1534 TbmpBitfieldFormat = class(TFormatDescriptor)
1536 procedure SetRedMask (const aValue: QWord);
1537 procedure SetGreenMask(const aValue: QWord);
1538 procedure SetBlueMask (const aValue: QWord);
1539 procedure SetAlphaMask(const aValue: QWord);
1541 procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1543 property RedMask: QWord read GetRedMask write SetRedMask;
1544 property GreenMask: QWord read GetGreenMask write SetGreenMask;
1545 property BlueMask: QWord read GetBlueMask write SetBlueMask;
1546 property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1548 property PixelSize: Single read fPixelSize write fPixelSize;
1550 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1551 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1554 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1555 TbmpColorTableEnty = packed record
1558 TbmpColorTable = array of TbmpColorTableEnty;
1559 TbmpColorTableFormat = class(TFormatDescriptor)
1561 fColorTable: TbmpColorTable;
1563 property PixelSize: Single read fPixelSize write fPixelSize;
1564 property ColorTable: TbmpColorTable read fColorTable write fColorTable;
1565 property Range: TglBitmapColorRec read fRange write fRange;
1566 property Shift: TShiftRec read fShift write fShift;
1567 property Format: TglBitmapFormat read fFormat write fFormat;
1569 procedure CreateColorTable;
1571 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1572 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1573 destructor Destroy; override;
1577 LUMINANCE_WEIGHT_R = 0.30;
1578 LUMINANCE_WEIGHT_G = 0.59;
1579 LUMINANCE_WEIGHT_B = 0.11;
1581 ALPHA_WEIGHT_R = 0.30;
1582 ALPHA_WEIGHT_G = 0.59;
1583 ALPHA_WEIGHT_B = 0.11;
1585 DEPTH_WEIGHT_R = 0.333333333;
1586 DEPTH_WEIGHT_G = 0.333333333;
1587 DEPTH_WEIGHT_B = 0.333333333;
1589 UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1591 FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1604 TfdLuminance4Alpha4,
1605 TfdLuminance6Alpha2,
1606 TfdLuminance8Alpha8,
1607 TfdLuminance12Alpha4,
1608 TfdLuminance12Alpha12,
1609 TfdLuminance16Alpha16,
1654 FormatDescriptorCS: TCriticalSection;
1655 FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1657 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1658 constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
1660 inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1663 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1664 constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
1666 inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
1669 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1670 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1672 result.Fields := [];
1675 result.Fields := result.Fields + [ffX];
1677 result.Fields := result.Fields + [ffY];
1679 result.X := Max(0, X);
1680 result.Y := Max(0, Y);
1683 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1684 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1692 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1693 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1698 for i := 0 to high(r1.arr) do
1699 if (r1.arr[i] <> r2.arr[i]) then
1704 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1705 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1713 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1714 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1723 tfR3G3B2, tfLuminance8,
1726 tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1727 tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1733 tfRGB10, tfRGB10A2, tfRGBA8,
1734 tfBGR10, tfBGR10A2, tfBGRA8]) then
1735 result := result + [ftBMP];
1739 tfLuminance8, tfAlpha8,
1742 tfLuminance16, tfLuminance8Alpha8,
1743 tfRGB5, tfRGB5A1, tfRGBA4,
1744 tfBGR5, tfBGR5A1, tfBGRA4,
1750 tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1751 result := result + [ftTGA];
1755 tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1756 tfR3G3B2, tfRGBA2, tfBGRA2,
1759 tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1760 tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1761 tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1767 tfLuminance16Alpha16,
1772 tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1773 result := result + [ftDDS];
1775 {$IFDEF GLB_SUPPORT_PNG_WRITE}
1777 tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
1779 tfBGR8, tfBGRA8] then
1780 result := result + [ftPNG];
1783 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1784 if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
1785 result := result + [ftJPEG];
1789 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1790 function IsPowerOfTwo(aNumber: Integer): Boolean;
1792 while (aNumber and 1) = 0 do
1793 aNumber := aNumber shr 1;
1794 result := aNumber = 1;
1797 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1798 function GetTopMostBit(aBitSet: QWord): Integer;
1801 while aBitSet > 0 do begin
1803 aBitSet := aBitSet shr 1;
1807 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1808 function CountSetBits(aBitSet: QWord): Integer;
1811 while aBitSet > 0 do begin
1812 if (aBitSet and 1) = 1 then
1814 aBitSet := aBitSet shr 1;
1818 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1819 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1822 LUMINANCE_WEIGHT_R * aPixel.Data.r +
1823 LUMINANCE_WEIGHT_G * aPixel.Data.g +
1824 LUMINANCE_WEIGHT_B * aPixel.Data.b);
1827 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1828 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1831 DEPTH_WEIGHT_R * aPixel.Data.r +
1832 DEPTH_WEIGHT_G * aPixel.Data.g +
1833 DEPTH_WEIGHT_B * aPixel.Data.b);
1836 {$IFDEF GLB_NATIVE_OGL}
1837 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1838 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1839 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1841 GL_LibHandle: Pointer = nil;
1843 function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
1847 if not Assigned(aLibHandle) then
1848 aLibHandle := GL_LibHandle;
1850 {$IF DEFINED(GLB_WIN)}
1851 result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1852 if Assigned(result) then
1855 if Assigned(wglGetProcAddress) then
1856 result := wglGetProcAddress(aProcName);
1857 {$ELSEIF DEFINED(GLB_LINUX)}
1858 if Assigned(glXGetProcAddress) then begin
1859 result := glXGetProcAddress(aProcName);
1860 if Assigned(result) then
1864 if Assigned(glXGetProcAddressARB) then begin
1865 result := glXGetProcAddressARB(aProcName);
1866 if Assigned(result) then
1870 result := dlsym(aLibHandle, aProcName);
1872 if not Assigned(result) then
1873 raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
1876 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1878 GLU_LibHandle: Pointer = nil;
1879 OpenGLInitialized: Boolean;
1880 InitOpenGLCS: TCriticalSection;
1882 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1883 procedure glbInitOpenGL;
1885 ////////////////////////////////////////////////////////////////////////////////
1886 function glbLoadLibrary(const aName: PChar): Pointer;
1888 {$IF DEFINED(GLB_WIN)}
1889 result := {%H-}Pointer(LoadLibrary(aName));
1890 {$ELSEIF DEFINED(GLB_LINUX)}
1891 result := dlopen(Name, RTLD_LAZY);
1897 ////////////////////////////////////////////////////////////////////////////////
1898 function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
1901 if not Assigned(aLibHandle) then
1904 {$IF DEFINED(GLB_WIN)}
1905 Result := FreeLibrary({%H-}HINST(aLibHandle));
1906 {$ELSEIF DEFINED(GLB_LINUX)}
1907 Result := dlclose(aLibHandle) = 0;
1912 if Assigned(GL_LibHandle) then
1913 glbFreeLibrary(GL_LibHandle);
1915 if Assigned(GLU_LibHandle) then
1916 glbFreeLibrary(GLU_LibHandle);
1918 GL_LibHandle := glbLoadLibrary(libopengl);
1919 if not Assigned(GL_LibHandle) then
1920 raise EglBitmapException.Create('unable to load library: ' + libopengl);
1922 GLU_LibHandle := glbLoadLibrary(libglu);
1923 if not Assigned(GLU_LibHandle) then
1924 raise EglBitmapException.Create('unable to load library: ' + libglu);
1927 {$IF DEFINED(GLB_WIN)}
1928 wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
1929 {$ELSEIF DEFINED(GLB_LINUX)}
1930 glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
1931 glXGetProcAddressARB := dglGetProcAddress('glXGetProcAddressARB');
1934 glEnable := glbGetProcAddress('glEnable');
1935 glDisable := glbGetProcAddress('glDisable');
1936 glGetString := glbGetProcAddress('glGetString');
1937 glGetIntegerv := glbGetProcAddress('glGetIntegerv');
1938 glTexParameteri := glbGetProcAddress('glTexParameteri');
1939 glTexParameterfv := glbGetProcAddress('glTexParameterfv');
1940 glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
1941 glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
1942 glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
1943 glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
1944 glGenTextures := glbGetProcAddress('glGenTextures');
1945 glBindTexture := glbGetProcAddress('glBindTexture');
1946 glDeleteTextures := glbGetProcAddress('glDeleteTextures');
1947 glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
1948 glReadPixels := glbGetProcAddress('glReadPixels');
1949 glPixelStorei := glbGetProcAddress('glPixelStorei');
1950 glTexImage1D := glbGetProcAddress('glTexImage1D');
1951 glTexImage2D := glbGetProcAddress('glTexImage2D');
1952 glGetTexImage := glbGetProcAddress('glGetTexImage');
1954 gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
1955 gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
1957 glbFreeLibrary(GL_LibHandle);
1958 glbFreeLibrary(GLU_LibHandle);
1963 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1964 procedure glbReadOpenGLExtensions;
1970 MajorVersion, MinorVersion: Integer;
1972 ///////////////////////////////////////////////////////////////////////////////////////////
1973 procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
1980 Separator := Pos(AnsiString('.'), aBuffer);
1981 if (Separator > 1) and (Separator < Length(aBuffer)) and
1982 (aBuffer[Separator - 1] in ['0'..'9']) and
1983 (aBuffer[Separator + 1] in ['0'..'9']) then begin
1986 while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
1989 Delete(aBuffer, 1, Separator);
1990 Separator := Pos(AnsiString('.'), aBuffer) + 1;
1992 while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
1995 Delete(aBuffer, Separator, 255);
1996 Separator := Pos(AnsiString('.'), aBuffer);
1998 aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
1999 aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2003 ///////////////////////////////////////////////////////////////////////////////////////////
2004 function CheckExtension(const Extension: AnsiString): Boolean;
2008 ExtPos := Pos(Extension, Buffer);
2009 result := ExtPos > 0;
2011 result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2015 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2018 if not OpenGLInitialized then begin
2020 OpenGLInitialized := true;
2028 Context := wglGetCurrentContext;
2029 if (Context <> gLastContext) then begin
2030 gLastContext := Context;
2034 Buffer := glGetString(GL_VERSION);
2035 TrimVersionString(Buffer, MajorVersion, MinorVersion);
2037 GL_VERSION_1_2 := false;
2038 GL_VERSION_1_3 := false;
2039 GL_VERSION_1_4 := false;
2040 GL_VERSION_2_0 := false;
2041 if MajorVersion = 1 then begin
2042 if MinorVersion >= 2 then
2043 GL_VERSION_1_2 := true;
2045 if MinorVersion >= 3 then
2046 GL_VERSION_1_3 := true;
2048 if MinorVersion >= 4 then
2049 GL_VERSION_1_4 := true;
2050 end else if MajorVersion >= 2 then begin
2051 GL_VERSION_1_2 := true;
2052 GL_VERSION_1_3 := true;
2053 GL_VERSION_1_4 := true;
2054 GL_VERSION_2_0 := true;
2058 Buffer := glGetString(GL_EXTENSIONS);
2059 GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
2060 GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
2061 GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
2062 GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
2063 GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
2064 GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2065 GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
2066 GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
2067 GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
2068 GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
2070 if GL_VERSION_1_3 then begin
2071 glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
2072 glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
2073 glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2075 glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB');
2076 glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB');
2077 glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
2087 function CreateGrayPalette: HPALETTE;
2092 GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
2094 Pal.palVersion := $300;
2095 Pal.palNumEntries := 256;
2098 {$DEFINE GLB_TEMPRANGECHECK}
2102 for Idx := 0 to 256 - 1 do begin
2103 Pal.palPalEntry[Idx].peRed := Idx;
2104 Pal.palPalEntry[Idx].peGreen := Idx;
2105 Pal.palPalEntry[Idx].peBlue := Idx;
2106 Pal.palPalEntry[Idx].peFlags := 0;
2109 {$IFDEF GLB_TEMPRANGECHECK}
2110 {$UNDEF GLB_TEMPRANGECHECK}
2114 result := CreatePalette(Pal^);
2121 {$IFDEF GLB_SDL_IMAGE}
2122 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2123 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2124 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2125 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2127 result := TStream(context^.unknown.data1).Seek(offset, whence);
2130 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2132 result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2135 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2137 result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2140 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2145 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2147 result := SDL_AllocRW;
2149 if result = nil then
2150 raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2152 result^.seek := glBitmapRWseek;
2153 result^.read := glBitmapRWread;
2154 result^.write := glBitmapRWwrite;
2155 result^.close := glBitmapRWclose;
2156 result^.unknown.data1 := Stream;
2160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2161 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2163 glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2166 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2167 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2169 glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2172 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2173 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2175 glBitmapDefaultMipmap := aValue;
2178 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2179 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2181 glBitmapDefaultFormat := aFormat;
2184 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2185 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2187 glBitmapDefaultFilterMin := aMin;
2188 glBitmapDefaultFilterMag := aMag;
2191 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2192 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2194 glBitmapDefaultWrapS := S;
2195 glBitmapDefaultWrapT := T;
2196 glBitmapDefaultWrapR := R;
2199 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2200 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2202 result := glBitmapDefaultDeleteTextureOnFree;
2205 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2206 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2208 result := glBitmapDefaultFreeDataAfterGenTextures;
2211 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2212 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2214 result := glBitmapDefaultMipmap;
2217 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2218 function glBitmapGetDefaultFormat: TglBitmapFormat;
2220 result := glBitmapDefaultFormat;
2223 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2224 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2226 aMin := glBitmapDefaultFilterMin;
2227 aMag := glBitmapDefaultFilterMag;
2230 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2231 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2233 S := glBitmapDefaultWrapS;
2234 T := glBitmapDefaultWrapT;
2235 R := glBitmapDefaultWrapR;
2238 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2239 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2240 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2241 function TFormatDescriptor.GetRedMask: QWord;
2243 result := fRange.r shl fShift.r;
2246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2247 function TFormatDescriptor.GetGreenMask: QWord;
2249 result := fRange.g shl fShift.g;
2252 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2253 function TFormatDescriptor.GetBlueMask: QWord;
2255 result := fRange.b shl fShift.b;
2258 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2259 function TFormatDescriptor.GetAlphaMask: QWord;
2261 result := fRange.a shl fShift.a;
2264 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2265 function TFormatDescriptor.GetComponents: Integer;
2271 if (fRange.arr[i] > 0) then
2275 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2276 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2280 if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2281 w := Max(1, aSize.X);
2282 h := Max(1, aSize.Y);
2283 result := GetSize(w, h);
2288 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2289 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2292 if (aWidth <= 0) or (aHeight <= 0) then
2294 result := Ceil(aWidth * aHeight * fPixelSize);
2297 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2298 function TFormatDescriptor.CreateMappingData: Pointer;
2303 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2304 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2310 function TFormatDescriptor.IsEmpty: Boolean;
2312 result := (fFormat = tfEmpty);
2315 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2316 function TFormatDescriptor.HasAlpha: Boolean;
2318 result := (fRange.a > 0);
2321 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2322 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2325 if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2326 raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
2327 if (aRedMask <> RedMask) then
2329 if (aGreenMask <> GreenMask) then
2331 if (aBlueMask <> BlueMask) then
2333 if (aAlphaMask <> AlphaMask) then
2338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2339 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2341 FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2342 aPixel.Data := fRange;
2343 aPixel.Range := fRange;
2344 aPixel.Format := fFormat;
2347 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2348 constructor TFormatDescriptor.Create;
2353 fWithAlpha := tfEmpty;
2354 fWithoutAlpha := tfEmpty;
2355 fRGBInverted := tfEmpty;
2356 fUncompressed := tfEmpty;
2358 fIsCompressed := false;
2361 fglInternalFormat := 0;
2364 FillChar(fRange, 0, SizeOf(fRange));
2365 FillChar(fShift, 0, SizeOf(fShift));
2368 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2369 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2370 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2371 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2373 aData^ := aPixel.Data.a;
2377 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2382 aPixel.Data.a := aData^;
2386 constructor TfdAlpha_UB1.Create;
2391 fglFormat := GL_ALPHA;
2392 fglDataFormat := GL_UNSIGNED_BYTE;
2395 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2396 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2397 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2398 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2400 aData^ := LuminanceWeight(aPixel);
2404 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2406 aPixel.Data.r := aData^;
2407 aPixel.Data.g := aData^;
2408 aPixel.Data.b := aData^;
2413 constructor TfdLuminance_UB1.Create;
2420 fglFormat := GL_LUMINANCE;
2421 fglDataFormat := GL_UNSIGNED_BYTE;
2424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2425 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2427 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2433 if (fRange.arr[i] > 0) then
2434 aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2438 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2443 aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2447 constructor TfdUniversal_UB1.Create;
2453 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2454 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2455 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2456 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2458 inherited Map(aPixel, aData, aMapData);
2459 aData^ := aPixel.Data.a;
2463 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2465 inherited Unmap(aData, aPixel, aMapData);
2466 aPixel.Data.a := aData^;
2470 constructor TfdLuminanceAlpha_UB2.Create;
2476 fglFormat := GL_LUMINANCE_ALPHA;
2477 fglDataFormat := GL_UNSIGNED_BYTE;
2480 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2481 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2483 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2485 aData^ := aPixel.Data.r;
2487 aData^ := aPixel.Data.g;
2489 aData^ := aPixel.Data.b;
2493 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2495 aPixel.Data.r := aData^;
2497 aPixel.Data.g := aData^;
2499 aPixel.Data.b := aData^;
2504 constructor TfdRGB_UB3.Create;
2514 fglFormat := GL_RGB;
2515 fglDataFormat := GL_UNSIGNED_BYTE;
2518 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2519 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2520 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2521 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2523 aData^ := aPixel.Data.b;
2525 aData^ := aPixel.Data.g;
2527 aData^ := aPixel.Data.r;
2531 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2533 aPixel.Data.b := aData^;
2535 aPixel.Data.g := aData^;
2537 aPixel.Data.r := aData^;
2542 constructor TfdBGR_UB3.Create;
2551 fglFormat := GL_BGR;
2552 fglDataFormat := GL_UNSIGNED_BYTE;
2555 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2556 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2557 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2558 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2560 inherited Map(aPixel, aData, aMapData);
2561 aData^ := aPixel.Data.a;
2565 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2567 inherited Unmap(aData, aPixel, aMapData);
2568 aPixel.Data.a := aData^;
2572 constructor TfdRGBA_UB4.Create;
2578 fglFormat := GL_RGBA;
2579 fglDataFormat := GL_UNSIGNED_BYTE;
2582 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2583 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2584 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2585 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2587 inherited Map(aPixel, aData, aMapData);
2588 aData^ := aPixel.Data.a;
2592 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2594 inherited Unmap(aData, aPixel, aMapData);
2595 aPixel.Data.a := aData^;
2599 constructor TfdBGRA_UB4.Create;
2605 fglFormat := GL_BGRA;
2606 fglDataFormat := GL_UNSIGNED_BYTE;
2609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2610 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2612 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2614 PWord(aData)^ := aPixel.Data.a;
2618 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2623 aPixel.Data.a := PWord(aData)^;
2627 constructor TfdAlpha_US1.Create;
2632 fglFormat := GL_ALPHA;
2633 fglDataFormat := GL_UNSIGNED_SHORT;
2636 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2637 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2638 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2639 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2641 PWord(aData)^ := LuminanceWeight(aPixel);
2645 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2647 aPixel.Data.r := PWord(aData)^;
2648 aPixel.Data.g := PWord(aData)^;
2649 aPixel.Data.b := PWord(aData)^;
2654 constructor TfdLuminance_US1.Create;
2661 fglFormat := GL_LUMINANCE;
2662 fglDataFormat := GL_UNSIGNED_SHORT;
2665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2666 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2667 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2668 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2674 if (fRange.arr[i] > 0) then
2675 PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2679 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2684 aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2688 constructor TfdUniversal_US1.Create;
2694 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2695 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2696 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2697 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2699 PWord(aData)^ := DepthWeight(aPixel);
2703 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2705 aPixel.Data.r := PWord(aData)^;
2706 aPixel.Data.g := PWord(aData)^;
2707 aPixel.Data.b := PWord(aData)^;
2712 constructor TfdDepth_US1.Create;
2719 fglFormat := GL_DEPTH_COMPONENT;
2720 fglDataFormat := GL_UNSIGNED_SHORT;
2723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2724 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2726 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2728 inherited Map(aPixel, aData, aMapData);
2729 PWord(aData)^ := aPixel.Data.a;
2733 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2735 inherited Unmap(aData, aPixel, aMapData);
2736 aPixel.Data.a := PWord(aData)^;
2740 constructor TfdLuminanceAlpha_US2.Create;
2746 fglFormat := GL_LUMINANCE_ALPHA;
2747 fglDataFormat := GL_UNSIGNED_SHORT;
2750 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2751 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2752 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2753 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2755 PWord(aData)^ := aPixel.Data.r;
2757 PWord(aData)^ := aPixel.Data.g;
2759 PWord(aData)^ := aPixel.Data.b;
2763 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2765 aPixel.Data.r := PWord(aData)^;
2767 aPixel.Data.g := PWord(aData)^;
2769 aPixel.Data.b := PWord(aData)^;
2774 constructor TfdRGB_US3.Create;
2784 fglFormat := GL_RGB;
2785 fglDataFormat := GL_UNSIGNED_SHORT;
2788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2789 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2790 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2791 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2793 PWord(aData)^ := aPixel.Data.b;
2795 PWord(aData)^ := aPixel.Data.g;
2797 PWord(aData)^ := aPixel.Data.r;
2801 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2803 aPixel.Data.b := PWord(aData)^;
2805 aPixel.Data.g := PWord(aData)^;
2807 aPixel.Data.r := PWord(aData)^;
2812 constructor TfdBGR_US3.Create;
2822 fglFormat := GL_BGR;
2823 fglDataFormat := GL_UNSIGNED_SHORT;
2826 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2827 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2828 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2829 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2831 inherited Map(aPixel, aData, aMapData);
2832 PWord(aData)^ := aPixel.Data.a;
2836 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2838 inherited Unmap(aData, aPixel, aMapData);
2839 aPixel.Data.a := PWord(aData)^;
2843 constructor TfdRGBA_US4.Create;
2849 fglFormat := GL_RGBA;
2850 fglDataFormat := GL_UNSIGNED_SHORT;
2853 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2854 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2855 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2856 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2858 inherited Map(aPixel, aData, aMapData);
2859 PWord(aData)^ := aPixel.Data.a;
2863 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2865 inherited Unmap(aData, aPixel, aMapData);
2866 aPixel.Data.a := PWord(aData)^;
2870 constructor TfdBGRA_US4.Create;
2876 fglFormat := GL_BGRA;
2877 fglDataFormat := GL_UNSIGNED_SHORT;
2880 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2881 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2882 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2883 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2887 PCardinal(aData)^ := 0;
2889 if (fRange.arr[i] > 0) then
2890 PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2894 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2899 aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2903 constructor TfdUniversal_UI1.Create;
2909 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2910 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2911 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2912 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2914 PCardinal(aData)^ := DepthWeight(aPixel);
2918 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2920 aPixel.Data.r := PCardinal(aData)^;
2921 aPixel.Data.g := PCardinal(aData)^;
2922 aPixel.Data.b := PCardinal(aData)^;
2927 constructor TfdDepth_UI1.Create;
2931 fRange.r := $FFFFFFFF;
2932 fRange.g := $FFFFFFFF;
2933 fRange.b := $FFFFFFFF;
2934 fglFormat := GL_DEPTH_COMPONENT;
2935 fglDataFormat := GL_UNSIGNED_INT;
2938 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2939 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2940 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2941 constructor TfdAlpha4.Create;
2944 fFormat := tfAlpha4;
2945 fWithAlpha := tfAlpha4;
2946 fglInternalFormat := GL_ALPHA4;
2949 constructor TfdAlpha8.Create;
2952 fFormat := tfAlpha8;
2953 fWithAlpha := tfAlpha8;
2954 fglInternalFormat := GL_ALPHA8;
2957 constructor TfdAlpha12.Create;
2960 fFormat := tfAlpha12;
2961 fWithAlpha := tfAlpha12;
2962 fglInternalFormat := GL_ALPHA12;
2965 constructor TfdAlpha16.Create;
2968 fFormat := tfAlpha16;
2969 fWithAlpha := tfAlpha16;
2970 fglInternalFormat := GL_ALPHA16;
2973 constructor TfdLuminance4.Create;
2976 fFormat := tfLuminance4;
2977 fWithAlpha := tfLuminance4Alpha4;
2978 fWithoutAlpha := tfLuminance4;
2979 fglInternalFormat := GL_LUMINANCE4;
2982 constructor TfdLuminance8.Create;
2985 fFormat := tfLuminance8;
2986 fWithAlpha := tfLuminance8Alpha8;
2987 fWithoutAlpha := tfLuminance8;
2988 fglInternalFormat := GL_LUMINANCE8;
2991 constructor TfdLuminance12.Create;
2994 fFormat := tfLuminance12;
2995 fWithAlpha := tfLuminance12Alpha12;
2996 fWithoutAlpha := tfLuminance12;
2997 fglInternalFormat := GL_LUMINANCE12;
3000 constructor TfdLuminance16.Create;
3003 fFormat := tfLuminance16;
3004 fWithAlpha := tfLuminance16Alpha16;
3005 fWithoutAlpha := tfLuminance16;
3006 fglInternalFormat := GL_LUMINANCE16;
3009 constructor TfdLuminance4Alpha4.Create;
3012 fFormat := tfLuminance4Alpha4;
3013 fWithAlpha := tfLuminance4Alpha4;
3014 fWithoutAlpha := tfLuminance4;
3015 fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3018 constructor TfdLuminance6Alpha2.Create;
3021 fFormat := tfLuminance6Alpha2;
3022 fWithAlpha := tfLuminance6Alpha2;
3023 fWithoutAlpha := tfLuminance8;
3024 fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3027 constructor TfdLuminance8Alpha8.Create;
3030 fFormat := tfLuminance8Alpha8;
3031 fWithAlpha := tfLuminance8Alpha8;
3032 fWithoutAlpha := tfLuminance8;
3033 fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3036 constructor TfdLuminance12Alpha4.Create;
3039 fFormat := tfLuminance12Alpha4;
3040 fWithAlpha := tfLuminance12Alpha4;
3041 fWithoutAlpha := tfLuminance12;
3042 fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3045 constructor TfdLuminance12Alpha12.Create;
3048 fFormat := tfLuminance12Alpha12;
3049 fWithAlpha := tfLuminance12Alpha12;
3050 fWithoutAlpha := tfLuminance12;
3051 fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3054 constructor TfdLuminance16Alpha16.Create;
3057 fFormat := tfLuminance16Alpha16;
3058 fWithAlpha := tfLuminance16Alpha16;
3059 fWithoutAlpha := tfLuminance16;
3060 fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3063 constructor TfdR3G3B2.Create;
3066 fFormat := tfR3G3B2;
3067 fWithAlpha := tfRGBA2;
3068 fWithoutAlpha := tfR3G3B2;
3075 fglFormat := GL_RGB;
3076 fglInternalFormat := GL_R3_G3_B2;
3077 fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
3080 constructor TfdRGB4.Create;
3084 fWithAlpha := tfRGBA4;
3085 fWithoutAlpha := tfRGB4;
3086 fRGBInverted := tfBGR4;
3093 fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3094 fglInternalFormat := GL_RGB4;
3095 fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3098 constructor TfdR5G6B5.Create;
3101 fFormat := tfR5G6B5;
3102 fWithAlpha := tfRGBA4;
3103 fWithoutAlpha := tfR5G6B5;
3104 fRGBInverted := tfB5G6R5;
3111 fglFormat := GL_RGB;
3112 fglInternalFormat := GL_RGB565;
3113 fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
3116 constructor TfdRGB5.Create;
3120 fWithAlpha := tfRGB5A1;
3121 fWithoutAlpha := tfRGB5;
3122 fRGBInverted := tfBGR5;
3129 fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3130 fglInternalFormat := GL_RGB5;
3131 fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3134 constructor TfdRGB8.Create;
3138 fWithAlpha := tfRGBA8;
3139 fWithoutAlpha := tfRGB8;
3140 fRGBInverted := tfBGR8;
3141 fglInternalFormat := GL_RGB8;
3144 constructor TfdRGB10.Create;
3148 fWithAlpha := tfRGB10A2;
3149 fWithoutAlpha := tfRGB10;
3150 fRGBInverted := tfBGR10;
3157 fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3158 fglInternalFormat := GL_RGB10;
3159 fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
3162 constructor TfdRGB12.Create;
3166 fWithAlpha := tfRGBA12;
3167 fWithoutAlpha := tfRGB12;
3168 fRGBInverted := tfBGR12;
3169 fglInternalFormat := GL_RGB12;
3172 constructor TfdRGB16.Create;
3176 fWithAlpha := tfRGBA16;
3177 fWithoutAlpha := tfRGB16;
3178 fRGBInverted := tfBGR16;
3179 fglInternalFormat := GL_RGB16;
3182 constructor TfdRGBA2.Create;
3186 fWithAlpha := tfRGBA2;
3187 fWithoutAlpha := tfR3G3B2;
3188 fRGBInverted := tfBGRA2;
3189 fglInternalFormat := GL_RGBA2;
3192 constructor TfdRGBA4.Create;
3196 fWithAlpha := tfRGBA4;
3197 fWithoutAlpha := tfRGB4;
3198 fRGBInverted := tfBGRA4;
3207 fglFormat := GL_RGBA;
3208 fglInternalFormat := GL_RGBA4;
3209 fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3212 constructor TfdRGB5A1.Create;
3215 fFormat := tfRGB5A1;
3216 fWithAlpha := tfRGB5A1;
3217 fWithoutAlpha := tfRGB5;
3218 fRGBInverted := tfBGR5A1;
3227 fglFormat := GL_RGBA;
3228 fglInternalFormat := GL_RGB5_A1;
3229 fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3232 constructor TfdRGBA8.Create;
3236 fWithAlpha := tfRGBA8;
3237 fWithoutAlpha := tfRGB8;
3238 fRGBInverted := tfBGRA8;
3239 fglInternalFormat := GL_RGBA8;
3242 constructor TfdRGB10A2.Create;
3245 fFormat := tfRGB10A2;
3246 fWithAlpha := tfRGB10A2;
3247 fWithoutAlpha := tfRGB10;
3248 fRGBInverted := tfBGR10A2;
3257 fglFormat := GL_RGBA;
3258 fglInternalFormat := GL_RGB10_A2;
3259 fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
3262 constructor TfdRGBA12.Create;
3265 fFormat := tfRGBA12;
3266 fWithAlpha := tfRGBA12;
3267 fWithoutAlpha := tfRGB12;
3268 fRGBInverted := tfBGRA12;
3269 fglInternalFormat := GL_RGBA12;
3272 constructor TfdRGBA16.Create;
3275 fFormat := tfRGBA16;
3276 fWithAlpha := tfRGBA16;
3277 fWithoutAlpha := tfRGB16;
3278 fRGBInverted := tfBGRA16;
3279 fglInternalFormat := GL_RGBA16;
3282 constructor TfdBGR4.Create;
3287 fWithAlpha := tfBGRA4;
3288 fWithoutAlpha := tfBGR4;
3289 fRGBInverted := tfRGB4;
3298 fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3299 fglInternalFormat := GL_RGB4;
3300 fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3303 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3304 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3305 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3306 constructor TfdB5G6R5.Create;
3309 fFormat := tfB5G6R5;
3310 fWithAlpha := tfBGRA4;
3311 fWithoutAlpha := tfB5G6R5;
3312 fRGBInverted := tfR5G6B5;
3319 fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3320 fglInternalFormat := GL_RGB8;
3321 fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
3324 constructor TfdBGR5.Create;
3329 fWithAlpha := tfBGR5A1;
3330 fWithoutAlpha := tfBGR5;
3331 fRGBInverted := tfRGB5;
3340 fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3341 fglInternalFormat := GL_RGB5;
3342 fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3345 constructor TfdBGR8.Create;
3349 fWithAlpha := tfBGRA8;
3350 fWithoutAlpha := tfBGR8;
3351 fRGBInverted := tfRGB8;
3352 fglInternalFormat := GL_RGB8;
3355 constructor TfdBGR10.Create;
3359 fWithAlpha := tfBGR10A2;
3360 fWithoutAlpha := tfBGR10;
3361 fRGBInverted := tfRGB10;
3370 fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3371 fglInternalFormat := GL_RGB10;
3372 fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
3375 constructor TfdBGR12.Create;
3379 fWithAlpha := tfBGRA12;
3380 fWithoutAlpha := tfBGR12;
3381 fRGBInverted := tfRGB12;
3382 fglInternalFormat := GL_RGB12;
3385 constructor TfdBGR16.Create;
3389 fWithAlpha := tfBGRA16;
3390 fWithoutAlpha := tfBGR16;
3391 fRGBInverted := tfRGB16;
3392 fglInternalFormat := GL_RGB16;
3395 constructor TfdBGRA2.Create;
3399 fWithAlpha := tfBGRA4;
3400 fWithoutAlpha := tfBGR4;
3401 fRGBInverted := tfRGBA2;
3402 fglInternalFormat := GL_RGBA2;
3405 constructor TfdBGRA4.Create;
3409 fWithAlpha := tfBGRA4;
3410 fWithoutAlpha := tfBGR4;
3411 fRGBInverted := tfRGBA4;
3420 fglFormat := GL_BGRA;
3421 fglInternalFormat := GL_RGBA4;
3422 fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3425 constructor TfdBGR5A1.Create;
3428 fFormat := tfBGR5A1;
3429 fWithAlpha := tfBGR5A1;
3430 fWithoutAlpha := tfBGR5;
3431 fRGBInverted := tfRGB5A1;
3440 fglFormat := GL_BGRA;
3441 fglInternalFormat := GL_RGB5_A1;
3442 fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3445 constructor TfdBGRA8.Create;
3449 fWithAlpha := tfBGRA8;
3450 fWithoutAlpha := tfBGR8;
3451 fRGBInverted := tfRGBA8;
3452 fglInternalFormat := GL_RGBA8;
3455 constructor TfdBGR10A2.Create;
3458 fFormat := tfBGR10A2;
3459 fWithAlpha := tfBGR10A2;
3460 fWithoutAlpha := tfBGR10;
3461 fRGBInverted := tfRGB10A2;
3470 fglFormat := GL_BGRA;
3471 fglInternalFormat := GL_RGB10_A2;
3472 fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
3475 constructor TfdBGRA12.Create;
3478 fFormat := tfBGRA12;
3479 fWithAlpha := tfBGRA12;
3480 fWithoutAlpha := tfBGR12;
3481 fRGBInverted := tfRGBA12;
3482 fglInternalFormat := GL_RGBA12;
3485 constructor TfdBGRA16.Create;
3488 fFormat := tfBGRA16;
3489 fWithAlpha := tfBGRA16;
3490 fWithoutAlpha := tfBGR16;
3491 fRGBInverted := tfRGBA16;
3492 fglInternalFormat := GL_RGBA16;
3495 constructor TfdDepth16.Create;
3498 fFormat := tfDepth16;
3499 fWithAlpha := tfEmpty;
3500 fWithoutAlpha := tfDepth16;
3501 fglInternalFormat := GL_DEPTH_COMPONENT16;
3504 constructor TfdDepth24.Create;
3507 fFormat := tfDepth24;
3508 fWithAlpha := tfEmpty;
3509 fWithoutAlpha := tfDepth24;
3510 fglInternalFormat := GL_DEPTH_COMPONENT24;
3513 constructor TfdDepth32.Create;
3516 fFormat := tfDepth32;
3517 fWithAlpha := tfEmpty;
3518 fWithoutAlpha := tfDepth32;
3519 fglInternalFormat := GL_DEPTH_COMPONENT32;
3522 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3523 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3524 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3525 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3527 raise EglBitmapException.Create('mapping for compressed formats is not supported');
3530 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3532 raise EglBitmapException.Create('mapping for compressed formats is not supported');
3535 constructor TfdS3tcDtx1RGBA.Create;
3538 fFormat := tfS3tcDtx1RGBA;
3539 fWithAlpha := tfS3tcDtx1RGBA;
3540 fUncompressed := tfRGB5A1;
3542 fIsCompressed := true;
3543 fglFormat := GL_COMPRESSED_RGBA;
3544 fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3545 fglDataFormat := GL_UNSIGNED_BYTE;
3548 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3549 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3550 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3551 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3553 raise EglBitmapException.Create('mapping for compressed formats is not supported');
3556 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3558 raise EglBitmapException.Create('mapping for compressed formats is not supported');
3561 constructor TfdS3tcDtx3RGBA.Create;
3564 fFormat := tfS3tcDtx3RGBA;
3565 fWithAlpha := tfS3tcDtx3RGBA;
3566 fUncompressed := tfRGBA8;
3568 fIsCompressed := true;
3569 fglFormat := GL_COMPRESSED_RGBA;
3570 fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3571 fglDataFormat := GL_UNSIGNED_BYTE;
3574 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3575 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3576 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3577 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3579 raise EglBitmapException.Create('mapping for compressed formats is not supported');
3582 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3584 raise EglBitmapException.Create('mapping for compressed formats is not supported');
3587 constructor TfdS3tcDtx5RGBA.Create;
3590 fFormat := tfS3tcDtx3RGBA;
3591 fWithAlpha := tfS3tcDtx3RGBA;
3592 fUncompressed := tfRGBA8;
3594 fIsCompressed := true;
3595 fglFormat := GL_COMPRESSED_RGBA;
3596 fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3597 fglDataFormat := GL_UNSIGNED_BYTE;
3600 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3601 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3603 class procedure TFormatDescriptor.Init;
3605 if not Assigned(FormatDescriptorCS) then
3606 FormatDescriptorCS := TCriticalSection.Create;
3609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3610 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3612 FormatDescriptorCS.Enter;
3614 result := FormatDescriptors[aFormat];
3615 if not Assigned(result) then begin
3616 result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3617 FormatDescriptors[aFormat] := result;
3620 FormatDescriptorCS.Leave;
3624 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3625 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3627 result := Get(Get(aFormat).WithAlpha);
3630 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3631 class procedure TFormatDescriptor.Clear;
3635 FormatDescriptorCS.Enter;
3637 for f := low(FormatDescriptors) to high(FormatDescriptors) do
3638 FreeAndNil(FormatDescriptors[f]);
3640 FormatDescriptorCS.Leave;
3644 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3645 class procedure TFormatDescriptor.Finalize;
3648 FreeAndNil(FormatDescriptorCS);
3651 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3652 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3654 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3656 Update(aValue, fRange.r, fShift.r);
3659 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3660 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3662 Update(aValue, fRange.g, fShift.g);
3665 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3666 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3668 Update(aValue, fRange.b, fShift.b);
3671 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3672 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3674 Update(aValue, fRange.a, fShift.a);
3677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3678 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3685 while (aMask > 0) and ((aMask and 1) = 0) do begin
3687 aMask := aMask shr 1;
3690 while (aMask > 0) do begin
3691 aRange := aRange shl 1;
3692 aMask := aMask shr 1;
3696 fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3699 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3700 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3706 ((aPixel.Data.r and fRange.r) shl fShift.r) or
3707 ((aPixel.Data.g and fRange.g) shl fShift.g) or
3708 ((aPixel.Data.b and fRange.b) shl fShift.b) or
3709 ((aPixel.Data.a and fRange.a) shl fShift.a);
3710 s := Round(fPixelSize);
3713 2: PWord(aData)^ := data;
3714 4: PCardinal(aData)^ := data;
3715 8: PQWord(aData)^ := data;
3717 raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3722 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3723 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3728 s := Round(fPixelSize);
3731 2: data := PWord(aData)^;
3732 4: data := PCardinal(aData)^;
3733 8: data := PQWord(aData)^;
3735 raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3738 aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3742 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3743 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3744 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3745 procedure TbmpColorTableFormat.CreateColorTable;
3749 if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3750 raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3752 if (Format = tfLuminance4) then
3753 SetLength(fColorTable, 16)
3755 SetLength(fColorTable, 256);
3759 for i := 0 to High(fColorTable) do begin
3760 fColorTable[i].r := 16 * i;
3761 fColorTable[i].g := 16 * i;
3762 fColorTable[i].b := 16 * i;
3763 fColorTable[i].a := 0;
3768 for i := 0 to High(fColorTable) do begin
3769 fColorTable[i].r := i;
3770 fColorTable[i].g := i;
3771 fColorTable[i].b := i;
3772 fColorTable[i].a := 0;
3777 for i := 0 to High(fColorTable) do begin
3778 fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3779 fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3780 fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3781 fColorTable[i].a := 0;
3787 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3788 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3792 if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3793 raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3797 if (aMapData = nil) then
3799 d := LuminanceWeight(aPixel) and Range.r;
3800 aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3802 if ({%H-}PtrUInt(aMapData) >= 8) then begin
3809 aData^ := LuminanceWeight(aPixel) and Range.r;
3815 ((aPixel.Data.r and Range.r) shl Shift.r) or
3816 ((aPixel.Data.g and Range.g) shl Shift.g) or
3817 ((aPixel.Data.b and Range.b) shl Shift.b));
3823 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3824 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3831 s := Trunc(fPixelSize);
3832 f := fPixelSize - s;
3833 bits := Round(8 * f);
3835 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
3837 2: idx := PWord(aData)^;
3838 4: idx := PCardinal(aData)^;
3839 8: idx := PQWord(aData)^;
3841 raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3843 if (idx >= Length(fColorTable)) then
3844 raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
3845 with fColorTable[idx] do begin
3851 inc(aMapData, bits);
3852 if ({%H-}PtrUInt(aMapData) >= 8) then begin
3859 destructor TbmpColorTableFormat.Destroy;
3861 SetLength(fColorTable, 0);
3865 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3866 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3867 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3868 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
3872 for i := 0 to 3 do begin
3873 if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
3874 if (aSourceFD.Range.arr[i] > 0) then
3875 aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
3877 aPixel.Data.arr[i] := aDestFD.Range.arr[i];
3882 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3883 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
3885 with aFuncRec do begin
3886 if (Source.Range.r > 0) then
3887 Dest.Data.r := Source.Data.r;
3888 if (Source.Range.g > 0) then
3889 Dest.Data.g := Source.Data.g;
3890 if (Source.Range.b > 0) then
3891 Dest.Data.b := Source.Data.b;
3892 if (Source.Range.a > 0) then
3893 Dest.Data.a := Source.Data.a;
3897 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3898 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3902 with aFuncRec do begin
3904 if (Source.Range.arr[i] > 0) then
3905 Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
3910 TShiftData = packed record
3912 0: (r, g, b, a: SmallInt);
3913 1: (arr: array[0..3] of SmallInt);
3915 PShiftData = ^TShiftData;
3917 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3918 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
3924 if (Source.Range.arr[i] > 0) then
3925 Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
3928 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3929 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
3931 with aFuncRec do begin
3932 Dest.Data := Source.Data;
3933 if ({%H-}PtrUInt(Args) and $1 > 0) then begin
3934 Dest.Data.r := Dest.Data.r xor Dest.Range.r;
3935 Dest.Data.g := Dest.Data.g xor Dest.Range.g;
3936 Dest.Data.b := Dest.Data.b xor Dest.Range.b;
3938 if ({%H-}PtrUInt(Args) and $2 > 0) then begin
3939 Dest.Data.a := Dest.Data.a xor Dest.Range.a;
3944 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3945 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
3949 with aFuncRec do begin
3951 Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
3955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3956 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3960 with FuncRec do begin
3961 if (FuncRec.Args = nil) then begin //source has no alpha
3963 Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
3964 Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
3965 Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
3966 Dest.Data.a := Round(Dest.Range.a * Temp);
3968 Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
3972 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3973 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3975 PglBitmapPixelData = ^TglBitmapPixelData;
3977 with FuncRec do begin
3978 Dest.Data.r := Source.Data.r;
3979 Dest.Data.g := Source.Data.g;
3980 Dest.Data.b := Source.Data.b;
3982 with PglBitmapPixelData(Args)^ do
3983 if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
3984 (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
3985 (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
3988 Dest.Data.a := Dest.Range.a;
3992 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3993 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
3995 with FuncRec do begin
3996 Dest.Data.r := Source.Data.r;
3997 Dest.Data.g := Source.Data.g;
3998 Dest.Data.b := Source.Data.b;
3999 Dest.Data.a := PCardinal(Args)^;
4003 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4004 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4007 TRGBPix = array [0..2] of byte;
4011 while aWidth > 0 do begin
4012 Temp := PRGBPix(aData)^[0];
4013 PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4014 PRGBPix(aData)^[2] := Temp;
4024 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4025 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4026 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4027 function TglBitmap.GetWidth: Integer;
4029 if (ffX in fDimension.Fields) then
4030 result := fDimension.X
4035 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4036 function TglBitmap.GetHeight: Integer;
4038 if (ffY in fDimension.Fields) then
4039 result := fDimension.Y
4044 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4045 function TglBitmap.GetFileWidth: Integer;
4047 result := Max(1, Width);
4050 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4051 function TglBitmap.GetFileHeight: Integer;
4053 result := Max(1, Height);
4056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4057 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4059 if fCustomData = aValue then
4061 fCustomData := aValue;
4064 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4065 procedure TglBitmap.SetCustomName(const aValue: String);
4067 if fCustomName = aValue then
4069 fCustomName := aValue;
4072 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4073 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4075 if fCustomNameW = aValue then
4077 fCustomNameW := aValue;
4080 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4081 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4083 if fDeleteTextureOnFree = aValue then
4085 fDeleteTextureOnFree := aValue;
4088 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4089 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4091 if fFormat = aValue then
4093 if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4094 raise EglBitmapUnsupportedFormat.Create(Format);
4095 SetDataPointer(Data, aValue, Width, Height);
4098 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4099 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4101 if fFreeDataAfterGenTexture = aValue then
4103 fFreeDataAfterGenTexture := aValue;
4106 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4107 procedure TglBitmap.SetID(const aValue: Cardinal);
4109 if fID = aValue then
4114 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4115 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4117 if fMipMap = aValue then
4122 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4123 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4125 if fTarget = aValue then
4130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4131 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4133 MaxAnisotropic: Integer;
4135 fAnisotropic := aValue;
4136 if (ID > 0) then begin
4137 if GL_EXT_texture_filter_anisotropic then begin
4138 if fAnisotropic > 0 then begin
4140 glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4141 if aValue > MaxAnisotropic then
4142 fAnisotropic := MaxAnisotropic;
4143 glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4152 procedure TglBitmap.CreateID;
4155 glDeleteTextures(1, @fID);
4156 glGenTextures(1, @fID);
4160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4161 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4163 // Set Up Parameters
4164 SetWrap(fWrapS, fWrapT, fWrapR);
4165 SetFilter(fFilterMin, fFilterMag);
4166 SetAnisotropic(fAnisotropic);
4167 SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4169 // Mip Maps Generation Mode
4170 aBuildWithGlu := false;
4171 if (MipMap = mmMipmap) then begin
4172 if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4173 glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4175 aBuildWithGlu := true;
4176 end else if (MipMap = mmMipmapGlu) then
4177 aBuildWithGlu := true;
4180 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4181 procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
4182 const aWidth: Integer; const aHeight: Integer);
4186 if (Data <> aData) then begin
4187 if (Assigned(Data)) then
4192 FillChar(fDimension, SizeOf(fDimension), 0);
4193 if not Assigned(fData) then begin
4198 if aWidth <> -1 then begin
4199 fDimension.Fields := fDimension.Fields + [ffX];
4200 fDimension.X := aWidth;
4203 if aHeight <> -1 then begin
4204 fDimension.Fields := fDimension.Fields + [ffY];
4205 fDimension.Y := aHeight;
4208 s := TFormatDescriptor.Get(aFormat).PixelSize;
4210 fPixelSize := Ceil(s);
4211 fRowSize := Ceil(s * aWidth);
4215 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4216 function TglBitmap.FlipHorz: Boolean;
4221 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4222 function TglBitmap.FlipVert: Boolean;
4227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4228 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4229 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4230 procedure TglBitmap.AfterConstruction;
4232 inherited AfterConstruction;
4236 fIsResident := false;
4238 fFormat := glBitmapGetDefaultFormat;
4239 fMipMap := glBitmapDefaultMipmap;
4240 fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4241 fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
4243 glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
4244 glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4247 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4248 procedure TglBitmap.BeforeDestruction;
4250 SetDataPointer(nil, tfEmpty);
4251 if (fID > 0) and fDeleteTextureOnFree then
4252 glDeleteTextures(1, @fID);
4253 inherited BeforeDestruction;
4256 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4257 procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
4261 if not Assigned(aResType) then begin
4262 TempPos := Pos('.', aResource);
4263 aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
4264 aResource := UpperCase(Copy(aResource, 0, TempPos -1));
4268 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4269 procedure TglBitmap.LoadFromFile(const aFilename: String);
4273 if not FileExists(aFilename) then
4274 raise EglBitmapException.Create('file does not exist: ' + aFilename);
4275 fFilename := aFilename;
4276 fs := TFileStream.Create(fFilename, fmOpenRead);
4285 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4286 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4288 {$IFDEF GLB_SUPPORT_PNG_READ}
4289 if not LoadPNG(aStream) then
4291 {$IFDEF GLB_SUPPORT_JPEG_READ}
4292 if not LoadJPEG(aStream) then
4294 if not LoadDDS(aStream) then
4295 if not LoadTGA(aStream) then
4296 if not LoadBMP(aStream) then
4297 raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4300 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4301 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4302 const aFormat: TglBitmapFormat; const aArgs: Pointer);
4307 size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4308 GetMem(tmpData, size);
4310 FillChar(tmpData^, size, #$FF);
4311 SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
4316 AddFunc(Self, aFunc, false, Format, aArgs);
4319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4320 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
4322 rs: TResourceStream;
4324 PrepareResType(aResource, aResType);
4325 rs := TResourceStream.Create(aInstance, aResource, aResType);
4333 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4334 procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4336 rs: TResourceStream;
4338 rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4346 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4347 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4351 fs := TFileStream.Create(aFileName, fmCreate);
4354 SaveToStream(fs, aFileType);
4360 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4361 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4364 {$IFDEF GLB_SUPPORT_PNG_WRITE}
4365 ftPNG: SavePNG(aStream);
4367 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4368 ftJPEG: SaveJPEG(aStream);
4370 ftDDS: SaveDDS(aStream);
4371 ftTGA: SaveTGA(aStream);
4372 ftBMP: SaveBMP(aStream);
4376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4377 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4379 result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4382 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4383 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4384 const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4386 DestData, TmpData, SourceData: pByte;
4387 TempHeight, TempWidth: Integer;
4388 SourceFD, DestFD: TFormatDescriptor;
4389 SourceMD, DestMD: Pointer;
4391 FuncRec: TglBitmapFunctionRec;
4393 Assert(Assigned(Data));
4394 Assert(Assigned(aSource));
4395 Assert(Assigned(aSource.Data));
4398 if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4399 SourceFD := TFormatDescriptor.Get(aSource.Format);
4400 DestFD := TFormatDescriptor.Get(aFormat);
4402 if (SourceFD.IsCompressed) then
4403 raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
4404 if (DestFD.IsCompressed) then
4405 raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
4407 // inkompatible Formats so CreateTemp
4408 if (SourceFD.PixelSize <> DestFD.PixelSize) then
4409 aCreateTemp := true;
4412 TempHeight := Max(1, aSource.Height);
4413 TempWidth := Max(1, aSource.Width);
4415 FuncRec.Sender := Self;
4416 FuncRec.Args := aArgs;
4419 if aCreateTemp then begin
4420 GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
4421 DestData := TmpData;
4426 SourceFD.PreparePixel(FuncRec.Source);
4427 DestFD.PreparePixel (FuncRec.Dest);
4429 SourceMD := SourceFD.CreateMappingData;
4430 DestMD := DestFD.CreateMappingData;
4432 FuncRec.Size := aSource.Dimension;
4433 FuncRec.Position.Fields := FuncRec.Size.Fields;
4436 SourceData := aSource.Data;
4437 FuncRec.Position.Y := 0;
4438 while FuncRec.Position.Y < TempHeight do begin
4439 FuncRec.Position.X := 0;
4440 while FuncRec.Position.X < TempWidth do begin
4441 SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4443 DestFD.Map(FuncRec.Dest, DestData, DestMD);
4444 inc(FuncRec.Position.X);
4446 inc(FuncRec.Position.Y);
4449 // Updating Image or InternalFormat
4451 SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
4452 else if (aFormat <> fFormat) then
4457 SourceFD.FreeMappingData(SourceMD);
4458 DestFD.FreeMappingData(DestMD);
4469 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4470 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4472 Row, RowSize: Integer;
4473 SourceData, TmpData: PByte;
4475 FormatDesc: TFormatDescriptor;
4477 function GetRowPointer(Row: Integer): pByte;
4479 result := aSurface.pixels;
4480 Inc(result, Row * RowSize);
4486 FormatDesc := TFormatDescriptor.Get(Format);
4487 if FormatDesc.IsCompressed then
4488 raise EglBitmapUnsupportedFormat.Create(Format);
4490 if Assigned(Data) then begin
4491 case Trunc(FormatDesc.PixelSize) of
4497 raise EglBitmapUnsupportedFormat.Create(Format);
4500 aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4501 FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4503 RowSize := FormatDesc.GetSize(FileWidth, 1);
4505 for Row := 0 to FileHeight-1 do begin
4506 TmpData := GetRowPointer(Row);
4507 if Assigned(TmpData) then begin
4508 Move(SourceData^, TmpData^, RowSize);
4509 inc(SourceData, RowSize);
4516 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4517 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4519 pSource, pData, pTempData: PByte;
4520 Row, RowSize, TempWidth, TempHeight: Integer;
4521 IntFormat: TglBitmapFormat;
4522 FormatDesc: TFormatDescriptor;
4524 function GetRowPointer(Row: Integer): pByte;
4526 result := aSurface^.pixels;
4527 Inc(result, Row * RowSize);
4532 if (Assigned(aSurface)) then begin
4533 with aSurface^.format^ do begin
4534 for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4535 FormatDesc := TFormatDescriptor.Get(IntFormat);
4536 if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4539 if (IntFormat = tfEmpty) then
4540 raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4543 TempWidth := aSurface^.w;
4544 TempHeight := aSurface^.h;
4545 RowSize := FormatDesc.GetSize(TempWidth, 1);
4546 GetMem(pData, TempHeight * RowSize);
4549 for Row := 0 to TempHeight -1 do begin
4550 pSource := GetRowPointer(Row);
4551 if (Assigned(pSource)) then begin
4552 Move(pSource^, pTempData^, RowSize);
4553 Inc(pTempData, RowSize);
4556 SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4565 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4566 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4568 Row, Col, AlphaInterleave: Integer;
4569 pSource, pDest: PByte;
4571 function GetRowPointer(Row: Integer): pByte;
4573 result := aSurface.pixels;
4574 Inc(result, Row * Width);
4579 if Assigned(Data) then begin
4580 if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4581 aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4583 AlphaInterleave := 0;
4586 AlphaInterleave := 1;
4588 AlphaInterleave := 3;
4592 for Row := 0 to Height -1 do begin
4593 pDest := GetRowPointer(Row);
4594 if Assigned(pDest) then begin
4595 for Col := 0 to Width -1 do begin
4596 Inc(pSource, AlphaInterleave);
4608 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4609 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4613 bmp := TglBitmap2D.Create;
4615 bmp.AssignFromSurface(aSurface);
4616 result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4624 //TODO rework & test
4625 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4626 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4629 pSource, pData: PByte;
4632 if Assigned(Data) then begin
4633 if Assigned(aBitmap) then begin
4634 aBitmap.Width := Width;
4635 aBitmap.Height := Height;
4638 tfAlpha8, ifLuminance, ifDepth8:
4640 Bitmap.PixelFormat := pf8bit;
4641 Bitmap.Palette := CreateGrayPalette;
4644 Bitmap.PixelFormat := pf15bit;
4646 Bitmap.PixelFormat := pf16bit;
4648 Bitmap.PixelFormat := pf24bit;
4650 Bitmap.PixelFormat := pf32bit;
4652 raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
4656 for Row := 0 to FileHeight -1 do begin
4657 pData := Bitmap.Scanline[Row];
4659 Move(pSource^, pData^, fRowSize);
4660 Inc(pSource, fRowSize);
4662 // swap RGB(A) to BGR(A)
4663 if InternalFormat in [ifRGB8, ifRGBA8] then
4664 SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
4672 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4673 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4675 pSource, pData, pTempData: PByte;
4676 Row, RowSize, TempWidth, TempHeight: Integer;
4677 IntFormat: TglBitmapInternalFormat;
4681 if (Assigned(Bitmap)) then begin
4682 case Bitmap.PixelFormat of
4684 IntFormat := ifLuminance;
4686 IntFormat := ifRGB5A1;
4688 IntFormat := ifR5G6B5;
4690 IntFormat := ifBGR8;
4692 IntFormat := ifBGRA8;
4694 raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
4697 TempWidth := Bitmap.Width;
4698 TempHeight := Bitmap.Height;
4700 RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
4702 GetMem(pData, TempHeight * RowSize);
4706 for Row := 0 to TempHeight -1 do begin
4707 pSource := Bitmap.Scanline[Row];
4709 if (Assigned(pSource)) then begin
4710 Move(pSource^, pTempData^, RowSize);
4711 Inc(pTempData, RowSize);
4715 SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4725 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4726 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4728 Row, Col, AlphaInterleave: Integer;
4729 pSource, pDest: PByte;
4733 if Assigned(Data) then begin
4734 if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
4735 if Assigned(Bitmap) then begin
4736 Bitmap.PixelFormat := pf8bit;
4737 Bitmap.Palette := CreateGrayPalette;
4738 Bitmap.Width := Width;
4739 Bitmap.Height := Height;
4741 case InternalFormat of
4743 AlphaInterleave := 1;
4745 AlphaInterleave := 3;
4747 AlphaInterleave := 0;
4753 for Row := 0 to Height -1 do begin
4754 pDest := Bitmap.Scanline[Row];
4756 if Assigned(pDest) then begin
4757 for Col := 0 to Width -1 do begin
4758 Inc(pSource, AlphaInterleave);
4772 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4773 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4777 tex := TglBitmap2D.Create;
4779 tex.AssignFromBitmap(Bitmap);
4780 result := AddAlphaFromglBitmap(tex, Func, CustomData);
4787 {$IFDEF GLB_LAZARUS}
4788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4789 function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4791 rid: TRawImageDescription;
4792 FormatDesc: TFormatDescriptor;
4795 if not Assigned(aImage) or (Format = tfEmpty) then
4797 FormatDesc := TFormatDescriptor.Get(Format);
4798 if FormatDesc.IsCompressed then
4801 FillChar(rid{%H-}, SizeOf(rid), 0);
4803 tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
4804 tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
4805 tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
4806 rid.Format := ricfGray
4808 rid.Format := ricfRGBA;
4811 rid.Height := Height;
4812 rid.Depth := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);
4813 rid.BitOrder := riboBitsInOrder;
4814 rid.ByteOrder := riboLSBFirst;
4815 rid.LineOrder := riloTopToBottom;
4816 rid.LineEnd := rileTight;
4817 rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
4818 rid.RedPrec := CountSetBits(FormatDesc.Range.r);
4819 rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
4820 rid.BluePrec := CountSetBits(FormatDesc.Range.b);
4821 rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
4822 rid.RedShift := FormatDesc.Shift.r;
4823 rid.GreenShift := FormatDesc.Shift.g;
4824 rid.BlueShift := FormatDesc.Shift.b;
4825 rid.AlphaShift := FormatDesc.Shift.a;
4827 rid.MaskBitsPerPixel := 0;
4828 rid.PaletteColorCount := 0;
4830 aImage.DataDescription := rid;
4833 Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
4838 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4839 function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
4842 FormatDesc: TFormatDescriptor;
4847 if not Assigned(aImage) then
4849 for f := High(f) downto Low(f) do begin
4850 FormatDesc := TFormatDescriptor.Get(f);
4851 with aImage.DataDescription do
4852 if FormatDesc.MaskMatch(
4853 (QWord(1 shl RedPrec )-1) shl RedShift,
4854 (QWord(1 shl GreenPrec)-1) shl GreenShift,
4855 (QWord(1 shl BluePrec )-1) shl BlueShift,
4856 (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
4860 if (f = tfEmpty) then
4863 ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
4864 ImageData := GetMem(ImageSize);
4866 Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
4867 SetDataPointer(ImageData, f, aImage.Width, aImage.Height);
4876 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4877 function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
4879 rid: TRawImageDescription;
4880 FormatDesc: TFormatDescriptor;
4881 Pixel: TglBitmapPixelData;
4887 if not Assigned(aImage) or (Format = tfEmpty) then
4889 FormatDesc := TFormatDescriptor.Get(Format);
4890 if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
4893 FillChar(rid{%H-}, SizeOf(rid), 0);
4894 rid.Format := ricfGray;
4896 rid.Height := Height;
4897 rid.Depth := CountSetBits(FormatDesc.Range.a);
4898 rid.BitOrder := riboBitsInOrder;
4899 rid.ByteOrder := riboLSBFirst;
4900 rid.LineOrder := riloTopToBottom;
4901 rid.LineEnd := rileTight;
4902 rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
4903 rid.RedPrec := CountSetBits(FormatDesc.Range.a);
4908 rid.GreenShift := 0;
4910 rid.AlphaShift := 0;
4912 rid.MaskBitsPerPixel := 0;
4913 rid.PaletteColorCount := 0;
4915 aImage.DataDescription := rid;
4918 srcMD := FormatDesc.CreateMappingData;
4920 FormatDesc.PreparePixel(Pixel);
4922 dst := aImage.PixelData;
4923 for y := 0 to Height-1 do
4924 for x := 0 to Width-1 do begin
4925 FormatDesc.Unmap(src, Pixel, srcMD);
4926 case rid.BitsPerPixel of
4928 dst^ := Pixel.Data.a;
4932 PWord(dst)^ := Pixel.Data.a;
4936 PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
4937 PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
4938 PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
4942 PCardinal(dst)^ := Pixel.Data.a;
4946 raise EglBitmapUnsupportedFormat.Create(Format);
4950 FormatDesc.FreeMappingData(srcMD);
4955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4956 function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4960 tex := TglBitmap2D.Create;
4962 tex.AssignFromLazIntfImage(aImage);
4963 result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4970 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4971 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
4972 const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4974 rs: TResourceStream;
4976 PrepareResType(aResource, aResType);
4977 rs := TResourceStream.Create(aInstance, aResource, aResType);
4979 result := AddAlphaFromStream(rs, aFunc, aArgs);
4985 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4986 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
4987 const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4989 rs: TResourceStream;
4991 rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
4993 result := AddAlphaFromStream(rs, aFunc, aArgs);
4999 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5000 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5002 if TFormatDescriptor.Get(Format).IsCompressed then
5003 raise EglBitmapUnsupportedFormat.Create(Format);
5004 result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
5007 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5008 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5012 FS := TFileStream.Create(FileName, fmOpenRead);
5014 result := AddAlphaFromStream(FS, aFunc, aArgs);
5020 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5021 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5025 tex := TglBitmap2D.Create(aStream);
5027 result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
5033 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5034 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
5036 DestData, DestData2, SourceData: pByte;
5037 TempHeight, TempWidth: Integer;
5038 SourceFD, DestFD: TFormatDescriptor;
5039 SourceMD, DestMD, DestMD2: Pointer;
5041 FuncRec: TglBitmapFunctionRec;
5045 Assert(Assigned(Data));
5046 Assert(Assigned(aBitmap));
5047 Assert(Assigned(aBitmap.Data));
5049 if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5050 result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5052 SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5053 DestFD := TFormatDescriptor.Get(Format);
5055 if not Assigned(aFunc) then begin
5056 aFunc := glBitmapAlphaFunc;
5057 FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5059 FuncRec.Args := aArgs;
5062 TempHeight := aBitmap.FileHeight;
5063 TempWidth := aBitmap.FileWidth;
5065 FuncRec.Sender := Self;
5066 FuncRec.Size := Dimension;
5067 FuncRec.Position.Fields := FuncRec.Size.Fields;
5071 SourceData := aBitmap.Data;
5074 SourceFD.PreparePixel(FuncRec.Source);
5075 DestFD.PreparePixel (FuncRec.Dest);
5077 SourceMD := SourceFD.CreateMappingData;
5078 DestMD := DestFD.CreateMappingData;
5079 DestMD2 := DestFD.CreateMappingData;
5081 FuncRec.Position.Y := 0;
5082 while FuncRec.Position.Y < TempHeight do begin
5083 FuncRec.Position.X := 0;
5084 while FuncRec.Position.X < TempWidth do begin
5085 SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5086 DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
5088 DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5089 inc(FuncRec.Position.X);
5091 inc(FuncRec.Position.Y);
5094 SourceFD.FreeMappingData(SourceMD);
5095 DestFD.FreeMappingData(DestMD);
5096 DestFD.FreeMappingData(DestMD2);
5101 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5102 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5104 result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5107 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5108 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5110 PixelData: TglBitmapPixelData;
5112 TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5113 result := AddAlphaFromColorKeyFloat(
5114 aRed / PixelData.Range.r,
5115 aGreen / PixelData.Range.g,
5116 aBlue / PixelData.Range.b,
5117 aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5120 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5121 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5123 values: array[0..2] of Single;
5126 PixelData: TglBitmapPixelData;
5128 TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5129 with PixelData do begin
5131 values[1] := aGreen;
5134 for i := 0 to 2 do begin
5135 tmp := Trunc(Range.arr[i] * aDeviation);
5136 Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5137 Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
5142 result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5145 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5146 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5148 result := AddAlphaFromValueFloat(aAlpha / $FF);
5151 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5152 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5154 PixelData: TglBitmapPixelData;
5156 TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5157 result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5160 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5161 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5163 PixelData: TglBitmapPixelData;
5165 TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5167 Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5168 result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5171 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5172 function TglBitmap.RemoveAlpha: Boolean;
5174 FormatDesc: TFormatDescriptor;
5177 FormatDesc := TFormatDescriptor.Get(Format);
5178 if Assigned(Data) then begin
5179 if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5180 raise EglBitmapUnsupportedFormat.Create(Format);
5181 result := ConvertTo(FormatDesc.WithoutAlpha);
5185 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5186 function TglBitmap.Clone: TglBitmap;
5193 Temp := (ClassType.Create as TglBitmap);
5195 // copy texture data if assigned
5196 if Assigned(Data) then begin
5197 Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5198 GetMem(TempPtr, Size);
5200 Move(Data^, TempPtr^, Size);
5201 Temp.SetDataPointer(TempPtr, Format, Width, Height);
5207 Temp.SetDataPointer(nil, Format, Width, Height);
5211 Temp.fTarget := Target;
5212 Temp.fFormat := Format;
5213 Temp.fMipMap := MipMap;
5214 Temp.fAnisotropic := Anisotropic;
5215 Temp.fBorderColor := fBorderColor;
5216 Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
5217 Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5218 Temp.fFilterMin := fFilterMin;
5219 Temp.fFilterMag := fFilterMag;
5220 Temp.fWrapS := fWrapS;
5221 Temp.fWrapT := fWrapT;
5222 Temp.fWrapR := fWrapR;
5223 Temp.fFilename := fFilename;
5224 Temp.fCustomName := fCustomName;
5225 Temp.fCustomNameW := fCustomNameW;
5226 Temp.fCustomData := fCustomData;
5235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5236 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5238 SourceFD, DestFD: TFormatDescriptor;
5239 SourcePD, DestPD: TglBitmapPixelData;
5240 ShiftData: TShiftData;
5242 function CanCopyDirect: Boolean;
5245 ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5246 ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5247 ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5248 ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5251 function CanShift: Boolean;
5254 ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5255 ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5256 ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5257 ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5260 function GetShift(aSource, aDest: Cardinal) : ShortInt;
5263 while (aSource > aDest) and (aSource > 0) do begin
5265 aSource := aSource shr 1;
5270 if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5271 SourceFD := TFormatDescriptor.Get(Format);
5272 DestFD := TFormatDescriptor.Get(aFormat);
5274 SourceFD.PreparePixel(SourcePD);
5275 DestFD.PreparePixel (DestPD);
5277 if CanCopyDirect then
5278 result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5279 else if CanShift then begin
5280 ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5281 ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5282 ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5283 ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5284 result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5286 result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5291 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5292 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5294 if aUseRGB or aUseAlpha then
5295 AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5296 ((PtrInt(aUseAlpha) and 1) shl 1) or
5297 (PtrInt(aUseRGB) and 1) ));
5300 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5301 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5303 fBorderColor[0] := aRed;
5304 fBorderColor[1] := aGreen;
5305 fBorderColor[2] := aBlue;
5306 fBorderColor[3] := aAlpha;
5307 if (ID > 0) then begin
5309 glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5313 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5314 procedure TglBitmap.FreeData;
5316 SetDataPointer(nil, tfEmpty);
5319 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5320 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5321 const aAlpha: Byte);
5323 FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5327 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5329 PixelData: TglBitmapPixelData;
5331 TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5333 aRed / PixelData.Range.r,
5334 aGreen / PixelData.Range.g,
5335 aBlue / PixelData.Range.b,
5336 aAlpha / PixelData.Range.a);
5339 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5340 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5342 PixelData: TglBitmapPixelData;
5344 TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5345 with PixelData do begin
5346 Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5347 Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5348 Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5349 Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5351 AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5354 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5355 procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
5360 fFilterMin := GL_NEAREST;
5362 fFilterMin := GL_LINEAR;
5363 GL_NEAREST_MIPMAP_NEAREST:
5364 fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5365 GL_LINEAR_MIPMAP_NEAREST:
5366 fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5367 GL_NEAREST_MIPMAP_LINEAR:
5368 fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5369 GL_LINEAR_MIPMAP_LINEAR:
5370 fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5372 raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
5378 fFilterMag := GL_NEAREST;
5380 fFilterMag := GL_LINEAR;
5382 raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
5386 if (ID > 0) then begin
5388 glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5390 if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5392 GL_NEAREST, GL_LINEAR:
5393 glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5394 GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5395 glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5396 GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5397 glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5400 glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5404 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5405 procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
5407 procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5411 aTarget := GL_CLAMP;
5414 aTarget := GL_REPEAT;
5416 GL_CLAMP_TO_EDGE: begin
5417 if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5418 aTarget := GL_CLAMP_TO_EDGE
5420 aTarget := GL_CLAMP;
5423 GL_CLAMP_TO_BORDER: begin
5424 if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5425 aTarget := GL_CLAMP_TO_BORDER
5427 aTarget := GL_CLAMP;
5430 GL_MIRRORED_REPEAT: begin
5431 if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5432 aTarget := GL_MIRRORED_REPEAT
5434 raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5437 raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
5442 CheckAndSetWrap(S, fWrapS);
5443 CheckAndSetWrap(T, fWrapT);
5444 CheckAndSetWrap(R, fWrapR);
5446 if (ID > 0) then begin
5448 glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5449 glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5450 glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5454 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5455 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5457 if aEnableTextureUnit then
5460 glBindTexture(Target, ID);
5463 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5464 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5466 if aDisableTextureUnit then
5468 glBindTexture(Target, 0);
5471 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5472 constructor TglBitmap.Create;
5474 {$IFDEF GLB_NATIVE_OGL}
5475 glbReadOpenGLExtensions;
5477 if (ClassType = TglBitmap) then
5478 raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5482 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5483 constructor TglBitmap.Create(const aFileName: String);
5486 LoadFromFile(FileName);
5489 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5490 constructor TglBitmap.Create(const aStream: TStream);
5493 LoadFromStream(aStream);
5496 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5497 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5503 ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5504 GetMem(Image, ImageSize);
5506 FillChar(Image^, ImageSize, #$FF);
5507 SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
5514 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5515 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5516 const aFunc: TglBitmapFunction; const aArgs: Pointer);
5519 LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5522 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5523 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5526 LoadFromResource(aInstance, aResource, aResType);
5529 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5530 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5533 LoadFromResourceID(aInstance, aResourceID, aResType);
5536 {$IFDEF GLB_SUPPORT_PNG_READ}
5537 {$IF DEFINED(GLB_SDL_IMAGE)}
5538 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5539 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5540 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5541 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5543 Surface: PSDL_Surface;
5547 RWops := glBitmapCreateRWops(aStream);
5549 if IMG_isPNG(RWops) > 0 then begin
5550 Surface := IMG_LoadPNG_RW(RWops);
5552 AssignFromSurface(Surface);
5555 SDL_FreeSurface(Surface);
5563 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5564 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5565 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5567 TStream(png_get_io_ptr(png)).Read(buffer^, size);
5570 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5571 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5574 signature: array [0..7] of byte;
5576 png_info: png_infop;
5578 TempHeight, TempWidth: Integer;
5579 Format: TglBitmapFormat;
5582 png_rows: array of pByte;
5583 Row, LineSize: Integer;
5587 if not init_libPNG then
5588 raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5592 StreamPos := aStream.Position;
5593 aStream.Read(signature{%H-}, 8);
5594 aStream.Position := StreamPos;
5596 if png_check_sig(@signature, 8) <> 0 then begin
5598 png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5600 raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5603 png_info := png_create_info_struct(png);
5604 if png_info = nil then begin
5605 png_destroy_read_struct(@png, nil, nil);
5606 raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5609 // set read callback
5610 png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
5612 // read informations
5613 png_read_info(png, png_info);
5616 TempHeight := png_get_image_height(png, png_info);
5617 TempWidth := png_get_image_width(png, png_info);
5620 case png_get_color_type(png, png_info) of
5621 PNG_COLOR_TYPE_GRAY:
5622 Format := tfLuminance8;
5623 PNG_COLOR_TYPE_GRAY_ALPHA:
5624 Format := tfLuminance8Alpha8;
5627 PNG_COLOR_TYPE_RGB_ALPHA:
5630 raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5633 // cut upper 8 bit from 16 bit formats
5634 if png_get_bit_depth(png, png_info) > 8 then
5635 png_set_strip_16(png);
5637 // expand bitdepth smaller than 8
5638 if png_get_bit_depth(png, png_info) < 8 then
5639 png_set_expand(png);
5641 // allocating mem for scanlines
5642 LineSize := png_get_rowbytes(png, png_info);
5643 GetMem(png_data, TempHeight * LineSize);
5645 SetLength(png_rows, TempHeight);
5646 for Row := Low(png_rows) to High(png_rows) do begin
5647 png_rows[Row] := png_data;
5648 Inc(png_rows[Row], Row * LineSize);
5651 // read complete image into scanlines
5652 png_read_image(png, @png_rows[0]);
5655 png_read_end(png, png_info);
5657 // destroy read struct
5658 png_destroy_read_struct(@png, @png_info, nil);
5660 SetLength(png_rows, 0);
5663 SetDataPointer(png_data, Format, TempWidth, TempHeight);
5676 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5678 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5683 Row, Col, PixSize, LineSize: Integer;
5684 NewImage, pSource, pDest, pAlpha: pByte;
5685 PngFormat: TglBitmapFormat;
5686 FormatDesc: TFormatDescriptor;
5689 PngHeader: String[8] = #137#80#78#71#13#10#26#10;
5694 StreamPos := aStream.Position;
5695 aStream.Read(Header[0], SizeOf(Header));
5696 aStream.Position := StreamPos;
5698 {Test if the header matches}
5699 if Header = PngHeader then begin
5700 Png := TPNGObject.Create;
5702 Png.LoadFromStream(aStream);
5704 case Png.Header.ColorType of
5706 PngFormat := tfLuminance8;
5707 COLOR_GRAYSCALEALPHA:
5708 PngFormat := tfLuminance8Alpha8;
5710 PngFormat := tfBGR8;
5712 PngFormat := tfBGRA8;
5714 raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5717 FormatDesc := TFormatDescriptor.Get(PngFormat);
5718 PixSize := Round(FormatDesc.PixelSize);
5719 LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
5721 GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5725 case Png.Header.ColorType of
5726 COLOR_RGB, COLOR_GRAYSCALE:
5728 for Row := 0 to Png.Height -1 do begin
5729 Move (Png.Scanline[Row]^, pDest^, LineSize);
5730 Inc(pDest, LineSize);
5733 COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5735 PixSize := PixSize -1;
5737 for Row := 0 to Png.Height -1 do begin
5738 pSource := Png.Scanline[Row];
5739 pAlpha := pByte(Png.AlphaScanline[Row]);
5741 for Col := 0 to Png.Width -1 do begin
5742 Move (pSource^, pDest^, PixSize);
5743 Inc(pSource, PixSize);
5744 Inc(pDest, PixSize);
5753 raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5756 SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
5771 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5772 {$IFDEF GLB_LIB_PNG}
5773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5774 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5776 TStream(png_get_io_ptr(png)).Write(buffer^, size);
5780 {$IF DEFINED(GLB_LIB_PNG)}
5781 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5782 procedure TglBitmap.SavePNG(const aStream: TStream);
5785 png_info: png_infop;
5786 png_rows: array of pByte;
5790 FormatDesc: TFormatDescriptor;
5792 if not (ftPNG in FormatGetSupportedFiles(Format)) then
5793 raise EglBitmapUnsupportedFormat.Create(Format);
5795 if not init_libPNG then
5796 raise Exception.Create('unable to initialize libPNG.');
5800 tfAlpha8, tfLuminance8:
5801 ColorType := PNG_COLOR_TYPE_GRAY;
5803 ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
5805 ColorType := PNG_COLOR_TYPE_RGB;
5807 ColorType := PNG_COLOR_TYPE_RGBA;
5809 raise EglBitmapUnsupportedFormat.Create(Format);
5812 FormatDesc := TFormatDescriptor.Get(Format);
5813 LineSize := FormatDesc.GetSize(Width, 1);
5815 // creating array for scanline
5816 SetLength(png_rows, Height);
5818 for Row := 0 to Height - 1 do begin
5819 png_rows[Row] := Data;
5820 Inc(png_rows[Row], Row * LineSize)
5824 png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5826 raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
5829 png_info := png_create_info_struct(png);
5830 if png_info = nil then begin
5831 png_destroy_write_struct(@png, nil);
5832 raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
5835 // set read callback
5836 png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
5839 png_set_compression_level(png, 6);
5841 if Format in [tfBGR8, tfBGRA8] then
5844 png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
5845 png_write_info(png, png_info);
5846 png_write_image(png, @png_rows[0]);
5847 png_write_end(png, png_info);
5848 png_destroy_write_struct(@png, @png_info);
5850 SetLength(png_rows, 0);
5857 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5858 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5859 procedure TglBitmap.SavePNG(const aStream: TStream);
5863 pSource, pDest: pByte;
5864 X, Y, PixSize: Integer;
5865 ColorType: Cardinal;
5871 if not (ftPNG in FormatGetSupportedFiles (Format)) then
5872 raise EglBitmapUnsupportedFormat.Create(Format);
5875 tfAlpha8, tfLuminance8: begin
5876 ColorType := COLOR_GRAYSCALE;
5880 tfLuminance8Alpha8: begin
5881 ColorType := COLOR_GRAYSCALEALPHA;
5885 tfBGR8, tfRGB8: begin
5886 ColorType := COLOR_RGB;
5890 tfBGRA8, tfRGBA8: begin
5891 ColorType := COLOR_RGBALPHA;
5896 raise EglBitmapUnsupportedFormat.Create(Format);
5899 Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
5903 for Y := 0 to Height -1 do begin
5904 pDest := png.ScanLine[Y];
5905 for X := 0 to Width -1 do begin
5906 Move(pSource^, pDest^, PixSize);
5907 Inc(pDest, PixSize);
5908 Inc(pSource, PixSize);
5910 png.AlphaScanline[Y]^[X] := pSource^;
5915 // convert RGB line to BGR
5916 if Format in [tfRGB8, tfRGBA8] then begin
5917 pTemp := png.ScanLine[Y];
5918 for X := 0 to Width -1 do begin
5919 Temp := pByteArray(pTemp)^[0];
5920 pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
5921 pByteArray(pTemp)^[2] := Temp;
5928 Png.CompressionLevel := 6;
5929 Png.SaveToStream(aStream);
5937 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5938 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5939 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5940 {$IFDEF GLB_LIB_JPEG}
5942 glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
5943 glBitmap_libJPEG_source_mgr = record
5944 pub: jpeg_source_mgr;
5947 SrcBuffer: array [1..4096] of byte;
5950 glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
5951 glBitmap_libJPEG_dest_mgr = record
5952 pub: jpeg_destination_mgr;
5954 DestStream: TStream;
5955 DestBuffer: array [1..4096] of byte;
5958 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
5964 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
5970 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
5975 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
5981 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
5987 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5988 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
5990 src: glBitmap_libJPEG_source_mgr_ptr;
5993 src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5995 bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
5996 if (bytes <= 0) then begin
5997 src^.SrcBuffer[1] := $FF;
5998 src^.SrcBuffer[2] := JPEG_EOI;
6002 src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
6003 src^.pub.bytes_in_buffer := bytes;
6008 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6009 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
6011 src: glBitmap_libJPEG_source_mgr_ptr;
6013 src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
6015 if num_bytes > 0 then begin
6016 // wanted byte isn't in buffer so set stream position and read buffer
6017 if num_bytes > src^.pub.bytes_in_buffer then begin
6018 src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
6019 src^.pub.fill_input_buffer(cinfo);
6021 // wanted byte is in buffer so only skip
6022 inc(src^.pub.next_input_byte, num_bytes);
6023 dec(src^.pub.bytes_in_buffer, num_bytes);
6028 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6029 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
6031 dest: glBitmap_libJPEG_dest_mgr_ptr;
6033 dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6035 if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
6036 // write complete buffer
6037 dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
6040 dest^.pub.next_output_byte := @dest^.DestBuffer[1];
6041 dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
6047 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6048 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
6051 dest: glBitmap_libJPEG_dest_mgr_ptr;
6053 dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
6055 for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
6056 // check for endblock
6057 if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
6059 dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
6064 dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
6069 {$IFDEF GLB_SUPPORT_JPEG_READ}
6070 {$IF DEFINED(GLB_SDL_IMAGE)}
6071 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6072 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6074 Surface: PSDL_Surface;
6079 RWops := glBitmapCreateRWops(aStream);
6081 if IMG_isJPG(RWops) > 0 then begin
6082 Surface := IMG_LoadJPG_RW(RWops);
6084 AssignFromSurface(Surface);
6087 SDL_FreeSurface(Surface);
6095 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6096 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6097 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6100 Temp: array[0..1]of Byte;
6102 jpeg: jpeg_decompress_struct;
6103 jpeg_err: jpeg_error_mgr;
6105 IntFormat: TglBitmapFormat;
6107 TempHeight, TempWidth: Integer;
6112 FormatDesc: TFormatDescriptor;
6116 if not init_libJPEG then
6117 raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6120 // reading first two bytes to test file and set cursor back to begin
6121 StreamPos := aStream.Position;
6122 aStream.Read({%H-}Temp[0], 2);
6123 aStream.Position := StreamPos;
6125 // if Bitmap then read file.
6126 if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6127 FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
6128 FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6131 jpeg.err := jpeg_std_error(@jpeg_err);
6132 jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
6133 jpeg_err.output_message := glBitmap_libJPEG_output_message;
6135 // decompression struct
6136 jpeg_create_decompress(@jpeg);
6138 // allocation space for streaming methods
6139 jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6141 // seeting up custom functions
6142 with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6143 pub.init_source := glBitmap_libJPEG_init_source;
6144 pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6145 pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
6146 pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6147 pub.term_source := glBitmap_libJPEG_term_source;
6149 pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
6150 pub.next_input_byte := nil; // until buffer loaded
6152 SrcStream := aStream;
6155 // set global decoding state
6156 jpeg.global_state := DSTATE_START;
6158 // read header of jpeg
6159 jpeg_read_header(@jpeg, false);
6161 // setting output parameter
6162 case jpeg.jpeg_color_space of
6165 jpeg.out_color_space := JCS_GRAYSCALE;
6166 IntFormat := tfLuminance8;
6169 jpeg.out_color_space := JCS_RGB;
6170 IntFormat := tfRGB8;
6174 jpeg_start_decompress(@jpeg);
6176 TempHeight := jpeg.output_height;
6177 TempWidth := jpeg.output_width;
6179 FormatDesc := TFormatDescriptor.Get(IntFormat);
6181 // creating new image
6182 GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
6186 for Row := 0 to TempHeight -1 do begin
6187 jpeg_read_scanlines(@jpeg, @pTemp, 1);
6188 Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
6191 // finish decompression
6192 jpeg_finish_decompress(@jpeg);
6194 // destroy decompression
6195 jpeg_destroy_decompress(@jpeg);
6197 SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
6210 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6211 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6212 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6217 Temp: array[0..1]of Byte;
6221 // reading first two bytes to test file and set cursor back to begin
6222 StreamPos := Stream.Position;
6223 Stream.Read(Temp[0], 2);
6224 Stream.Position := StreamPos;
6226 // if Bitmap then read file.
6227 if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6228 bmp := TBitmap.Create;
6230 jpg := TJPEGImage.Create;
6232 jpg.LoadFromStream(Stream);
6234 result := AssignFromBitmap(bmp);
6246 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6247 {$IF DEFINED(GLB_LIB_JPEG)}
6248 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6249 procedure TglBitmap.SaveJPEG(const aStream: TStream);
6251 jpeg: jpeg_compress_struct;
6252 jpeg_err: jpeg_error_mgr;
6254 pTemp, pTemp2: pByte;
6256 procedure CopyRow(pDest, pSource: pByte);
6260 for X := 0 to Width - 1 do begin
6261 pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6262 pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6263 pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6270 if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6271 raise EglBitmapUnsupportedFormat.Create(Format);
6273 if not init_libJPEG then
6274 raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6277 FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
6278 FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
6281 jpeg.err := jpeg_std_error(@jpeg_err);
6282 jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
6283 jpeg_err.output_message := glBitmap_libJPEG_output_message;
6285 // compression struct
6286 jpeg_create_compress(@jpeg);
6288 // allocation space for streaming methods
6289 jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6291 // seeting up custom functions
6292 with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6293 pub.init_destination := glBitmap_libJPEG_init_destination;
6294 pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6295 pub.term_destination := glBitmap_libJPEG_term_destination;
6297 pub.next_output_byte := @DestBuffer[1];
6298 pub.free_in_buffer := Length(DestBuffer);
6300 DestStream := aStream;
6303 // very important state
6304 jpeg.global_state := CSTATE_START;
6305 jpeg.image_width := Width;
6306 jpeg.image_height := Height;
6308 tfAlpha8, tfLuminance8: begin
6309 jpeg.input_components := 1;
6310 jpeg.in_color_space := JCS_GRAYSCALE;
6312 tfRGB8, tfBGR8: begin
6313 jpeg.input_components := 3;
6314 jpeg.in_color_space := JCS_RGB;
6318 jpeg_set_defaults(@jpeg);
6319 jpeg_set_quality(@jpeg, 95, true);
6320 jpeg_start_compress(@jpeg, true);
6323 if Format = tfBGR8 then
6324 GetMem(pTemp2, fRowSize)
6329 for Row := 0 to jpeg.image_height -1 do begin
6331 if Format = tfBGR8 then
6332 CopyRow(pTemp2, pTemp)
6337 jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6338 inc(pTemp, fRowSize);
6342 if Format = tfBGR8 then
6345 jpeg_finish_compress(@jpeg);
6346 jpeg_destroy_compress(@jpeg);
6352 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6353 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6354 procedure TglBitmap.SaveJPEG(Stream: TStream);
6359 if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
6360 raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
6362 Bmp := TBitmap.Create;
6364 Jpg := TJPEGImage.Create;
6366 AssignToBitmap(Bmp);
6367 if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
6368 Jpg.Grayscale := true;
6369 Jpg.PixelFormat := jf8Bit;
6372 Jpg.SaveToStream(Stream);
6383 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6384 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6392 BMP_COMP_BITFIELDS = 3;
6395 TBMPHeader = packed record
6400 bfOffBits: Cardinal;
6403 TBMPInfo = packed record
6409 biCompression: Cardinal;
6410 biSizeImage: Cardinal;
6411 biXPelsPerMeter: Longint;
6412 biYPelsPerMeter: Longint;
6413 biClrUsed: Cardinal;
6414 biClrImportant: Cardinal;
6417 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6418 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6420 //////////////////////////////////////////////////////////////////////////////////////////////////
6421 function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6424 aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6425 FillChar(aMask{%H-}, SizeOf(aMask), 0);
6428 case aInfo.biCompression of
6430 BMP_COMP_RLE8: begin
6431 raise EglBitmapException.Create('RLE compression is not supported');
6433 BMP_COMP_BITFIELDS: begin
6434 if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6435 aStream.Read(aMask.r, SizeOf(aMask.r));
6436 aStream.Read(aMask.g, SizeOf(aMask.g));
6437 aStream.Read(aMask.b, SizeOf(aMask.b));
6438 aStream.Read(aMask.a, SizeOf(aMask.a));
6440 raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
6444 //get suitable format
6445 case aInfo.biBitCount of
6446 8: result := tfLuminance8;
6447 16: result := tfBGR5;
6448 24: result := tfBGR8;
6449 32: result := tfBGRA8;
6453 function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6456 ColorTable: TbmpColorTable;
6459 if (aInfo.biBitCount >= 16) then
6461 aFormat := tfLuminance8;
6462 c := aInfo.biClrUsed;
6464 c := 1 shl aInfo.biBitCount;
6465 SetLength(ColorTable, c);
6466 for i := 0 to c-1 do begin
6467 aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6468 if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6472 result := TbmpColorTableFormat.Create;
6473 result.PixelSize := aInfo.biBitCount / 8;
6474 result.ColorTable := ColorTable;
6475 result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
6478 //////////////////////////////////////////////////////////////////////////////////////////////////
6479 function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6480 const aInfo: TBMPInfo): TbmpBitfieldFormat;
6482 TmpFormat: TglBitmapFormat;
6483 FormatDesc: TFormatDescriptor;
6486 if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6487 for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6488 FormatDesc := TFormatDescriptor.Get(TmpFormat);
6489 if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6490 aFormat := FormatDesc.Format;
6495 if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6496 aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6497 if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6498 aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6500 result := TbmpBitfieldFormat.Create;
6501 result.PixelSize := aInfo.biBitCount / 8;
6502 result.RedMask := aMask.r;
6503 result.GreenMask := aMask.g;
6504 result.BlueMask := aMask.b;
6505 result.AlphaMask := aMask.a;
6512 ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6513 PaddingBuff: Cardinal;
6514 LineBuf, ImageData, TmpData: PByte;
6515 SourceMD, DestMD: Pointer;
6516 BmpFormat: TglBitmapFormat;
6519 Mask: TglBitmapColorRec;
6524 SpecialFormat: TFormatDescriptor;
6525 FormatDesc: TFormatDescriptor;
6527 //////////////////////////////////////////////////////////////////////////////////////////////////
6528 procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6531 Pixel: TglBitmapPixelData;
6533 aStream.Read(aLineBuf^, rbLineSize);
6534 SpecialFormat.PreparePixel(Pixel);
6535 for i := 0 to Info.biWidth-1 do begin
6536 SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6537 glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6538 FormatDesc.Map(Pixel, aData, DestMD);
6544 BmpFormat := tfEmpty;
6545 SpecialFormat := nil;
6551 StartPos := aStream.Position;
6552 aStream.Read(Header{%H-}, SizeOf(Header));
6554 if Header.bfType = BMP_MAGIC then begin
6556 BmpFormat := ReadInfo(Info, Mask);
6557 SpecialFormat := ReadColorTable(BmpFormat, Info);
6558 if not Assigned(SpecialFormat) then
6559 SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
6560 aStream.Position := StartPos + Header.bfOffBits;
6562 if (BmpFormat <> tfEmpty) then begin
6563 FormatDesc := TFormatDescriptor.Get(BmpFormat);
6564 rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6565 wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6566 Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6569 DestMD := FormatDesc.CreateMappingData;
6570 ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6571 GetMem(ImageData, ImageSize);
6572 if Assigned(SpecialFormat) then begin
6573 GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6574 SourceMD := SpecialFormat.CreateMappingData;
6579 FillChar(ImageData^, ImageSize, $FF);
6580 TmpData := ImageData;
6581 if (Info.biHeight > 0) then
6582 Inc(TmpData, wbLineSize * (Info.biHeight-1));
6583 for i := 0 to Abs(Info.biHeight)-1 do begin
6584 if Assigned(SpecialFormat) then
6585 SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
6587 aStream.Read(TmpData^, wbLineSize); //else only read data
6588 if (Info.biHeight > 0) then
6589 dec(TmpData, wbLineSize)
6591 inc(TmpData, wbLineSize);
6592 aStream.Read(PaddingBuff{%H-}, Padding);
6594 SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
6597 if Assigned(LineBuf) then
6599 if Assigned(SourceMD) then
6600 SpecialFormat.FreeMappingData(SourceMD);
6601 FormatDesc.FreeMappingData(DestMD);
6608 raise EglBitmapException.Create('LoadBMP - No suitable format found');
6610 aStream.Position := StartPos;
6614 FreeAndNil(SpecialFormat);
6617 else aStream.Position := StartPos;
6620 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6621 procedure TglBitmap.SaveBMP(const aStream: TStream);
6625 Converter: TbmpColorTableFormat;
6626 FormatDesc: TFormatDescriptor;
6627 SourceFD, DestFD: Pointer;
6628 pData, srcData, dstData, ConvertBuffer: pByte;
6630 Pixel: TglBitmapPixelData;
6631 ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6632 RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6634 PaddingBuff: Cardinal;
6636 function GetLineWidth : Integer;
6638 result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6642 if not (ftBMP in FormatGetSupportedFiles(Format)) then
6643 raise EglBitmapUnsupportedFormat.Create(Format);
6646 FormatDesc := TFormatDescriptor.Get(Format);
6647 ImageSize := FormatDesc.GetSize(Dimension);
6649 FillChar(Header{%H-}, SizeOf(Header), 0);
6650 Header.bfType := BMP_MAGIC;
6651 Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
6652 Header.bfReserved1 := 0;
6653 Header.bfReserved2 := 0;
6654 Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
6656 FillChar(Info{%H-}, SizeOf(Info), 0);
6657 Info.biSize := SizeOf(Info);
6658 Info.biWidth := Width;
6659 Info.biHeight := Height;
6661 Info.biCompression := BMP_COMP_RGB;
6662 Info.biSizeImage := ImageSize;
6667 Info.biBitCount := 4;
6668 Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
6669 Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6670 Converter := TbmpColorTableFormat.Create;
6671 Converter.PixelSize := 0.5;
6672 Converter.Format := Format;
6673 Converter.Range := glBitmapColorRec($F, $F, $F, $0);
6674 Converter.CreateColorTable;
6677 tfR3G3B2, tfLuminance8: begin
6678 Info.biBitCount := 8;
6679 Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
6680 Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6681 Converter := TbmpColorTableFormat.Create;
6682 Converter.PixelSize := 1;
6683 Converter.Format := Format;
6684 if (Format = tfR3G3B2) then begin
6685 Converter.Range := glBitmapColorRec($7, $7, $3, $0);
6686 Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
6688 Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
6689 Converter.CreateColorTable;
6692 tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6693 tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6694 Info.biBitCount := 16;
6695 Info.biCompression := BMP_COMP_BITFIELDS;
6698 tfBGR8, tfRGB8: begin
6699 Info.biBitCount := 24;
6702 tfRGB10, tfRGB10A2, tfRGBA8,
6703 tfBGR10, tfBGR10A2, tfBGRA8: begin
6704 Info.biBitCount := 32;
6705 Info.biCompression := BMP_COMP_BITFIELDS;
6708 raise EglBitmapUnsupportedFormat.Create(Format);
6710 Info.biXPelsPerMeter := 2835;
6711 Info.biYPelsPerMeter := 2835;
6714 if Info.biCompression = BMP_COMP_BITFIELDS then begin
6715 Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
6716 Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
6718 RedMask := FormatDesc.RedMask;
6719 GreenMask := FormatDesc.GreenMask;
6720 BlueMask := FormatDesc.BlueMask;
6721 AlphaMask := FormatDesc.AlphaMask;
6725 aStream.Write(Header, SizeOf(Header));
6726 aStream.Write(Info, SizeOf(Info));
6729 if Assigned(Converter) then
6730 aStream.Write(Converter.ColorTable[0].b,
6731 SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
6734 if Info.biCompression = BMP_COMP_BITFIELDS then begin
6735 aStream.Write(RedMask, SizeOf(Cardinal));
6736 aStream.Write(GreenMask, SizeOf(Cardinal));
6737 aStream.Write(BlueMask, SizeOf(Cardinal));
6738 aStream.Write(AlphaMask, SizeOf(Cardinal));
6742 rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
6743 wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
6744 Padding := GetLineWidth - wbLineSize;
6748 inc(pData, (Height-1) * rbLineSize);
6750 // prepare row buffer. But only for RGB because RGBA supports color masks
6751 // so it's possible to change color within the image.
6752 if Assigned(Converter) then begin
6753 FormatDesc.PreparePixel(Pixel);
6754 GetMem(ConvertBuffer, wbLineSize);
6755 SourceFD := FormatDesc.CreateMappingData;
6756 DestFD := Converter.CreateMappingData;
6758 ConvertBuffer := nil;
6761 for LineIdx := 0 to Height - 1 do begin
6763 if Assigned(Converter) then begin
6765 dstData := ConvertBuffer;
6766 for PixelIdx := 0 to Info.biWidth-1 do begin
6767 FormatDesc.Unmap(srcData, Pixel, SourceFD);
6768 glBitmapConvertPixel(Pixel, FormatDesc, Converter);
6769 Converter.Map(Pixel, dstData, DestFD);
6771 aStream.Write(ConvertBuffer^, wbLineSize);
6773 aStream.Write(pData^, rbLineSize);
6775 dec(pData, rbLineSize);
6776 if (Padding > 0) then
6777 aStream.Write(PaddingBuff, Padding);
6780 // destroy row buffer
6781 if Assigned(ConvertBuffer) then begin
6782 FormatDesc.FreeMappingData(SourceFD);
6783 Converter.FreeMappingData(DestFD);
6784 FreeMem(ConvertBuffer);
6788 if Assigned(Converter) then
6793 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6794 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6795 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6797 TTGAHeader = packed record
6801 //ColorMapSpec: Array[0..4] of Byte;
6802 ColorMapStart: Word;
6803 ColorMapLength: Word;
6804 ColorMapEntrySize: Byte;
6814 TGA_UNCOMPRESSED_RGB = 2;
6815 TGA_UNCOMPRESSED_GRAY = 3;
6816 TGA_COMPRESSED_RGB = 10;
6817 TGA_COMPRESSED_GRAY = 11;
6819 TGA_NONE_COLOR_TABLE = 0;
6821 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6822 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
6825 ImageData: System.PByte;
6826 StartPosition: Int64;
6827 PixelSize, LineSize: Integer;
6828 tgaFormat: TglBitmapFormat;
6829 FormatDesc: TFormatDescriptor;
6830 Counter: packed record
6832 low, high, dir: Integer;
6839 ////////////////////////////////////////////////////////////////////////////////////////
6840 procedure ReadUncompressed;
6843 buf, tmp1, tmp2: System.PByte;
6846 if (Counter.X.dir < 0) then
6847 buf := GetMem(LineSize);
6849 while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
6850 tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
6851 if (Counter.X.dir < 0) then begin //flip X
6852 aStream.Read(buf^, LineSize);
6853 tmp2 := buf + LineSize - PixelSize; //pointer to last pixel in line
6854 for i := 0 to Header.Width-1 do begin //for all pixels in line
6855 for j := 0 to PixelSize-1 do begin //for all bytes in pixel
6860 dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
6863 aStream.Read(tmp1^, LineSize);
6864 inc(Counter.Y.low, Counter.Y.dir); //move to next line index
6867 if Assigned(buf) then
6872 ////////////////////////////////////////////////////////////////////////////////////////
6873 procedure ReadCompressed;
6875 /////////////////////////////////////////////////////////////////
6877 TmpData: System.PByte;
6878 LinePixelsRead: Integer;
6879 procedure CheckLine;
6881 if (LinePixelsRead >= Header.Width) then begin
6882 LinePixelsRead := 0;
6883 inc(Counter.Y.low, Counter.Y.dir); //next line index
6884 TmpData := ImageData + Counter.Y.low * LineSize; //set line
6885 if (Counter.X.dir < 0) then //if x flipped then
6886 TmpData := TmpData + LineSize - PixelSize; //set last pixel
6890 /////////////////////////////////////////////////////////////////
6893 CacheSize, CachePos: Integer;
6894 procedure CachedRead(out Buffer; Count: Integer);
6898 if (CachePos + Count > CacheSize) then begin
6899 //if buffer overflow save non read bytes
6901 if (CacheSize - CachePos > 0) then begin
6902 BytesRead := CacheSize - CachePos;
6903 Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
6904 inc(CachePos, BytesRead);
6907 //load cache from file
6908 CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6909 aStream.Read(Cache^, CacheSize);
6912 //read rest of requested bytes
6913 if (Count - BytesRead > 0) then begin
6914 Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6915 inc(CachePos, Count - BytesRead);
6918 //if no buffer overflow just read the data
6919 Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6920 inc(CachePos, Count);
6924 procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6929 inc(aBuffer, Counter.X.dir);
6932 PWord(aBuffer)^ := PWord(aData)^;
6933 inc(aBuffer, 2 * Counter.X.dir);
6936 PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6937 PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6938 PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6939 inc(aBuffer, 3 * Counter.X.dir);
6942 PCardinal(aBuffer)^ := PCardinal(aData)^;
6943 inc(aBuffer, 4 * Counter.X.dir);
6949 TotalPixelsToRead, TotalPixelsRead: Integer;
6951 buf: array [0..3] of Byte; //1 pixel is max 32bit long
6952 PixelRepeat: Boolean;
6953 PixelsToRead, PixelCount: Integer;
6958 TotalPixelsToRead := Header.Width * Header.Height;
6959 TotalPixelsRead := 0;
6960 LinePixelsRead := 0;
6962 GetMem(Cache, CACHE_SIZE);
6964 TmpData := ImageData + Counter.Y.low * LineSize; //set line
6965 if (Counter.X.dir < 0) then //if x flipped then
6966 TmpData := TmpData + LineSize - PixelSize; //set last pixel
6970 CachedRead(Temp, 1);
6971 PixelRepeat := (Temp and $80) > 0;
6972 PixelsToRead := (Temp and $7F) + 1;
6973 inc(TotalPixelsRead, PixelsToRead);
6976 CachedRead(buf[0], PixelSize);
6977 while (PixelsToRead > 0) do begin
6979 PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6980 while (PixelCount > 0) do begin
6981 if not PixelRepeat then
6982 CachedRead(buf[0], PixelSize);
6983 PixelToBuffer(@buf[0], TmpData);
6984 inc(LinePixelsRead);
6989 until (TotalPixelsRead >= TotalPixelsToRead);
6995 function IsGrayFormat: Boolean;
6997 result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
7003 // reading header to test file and set cursor back to begin
7004 StartPosition := aStream.Position;
7005 aStream.Read(Header{%H-}, SizeOf(Header));
7007 // no colormapped files
7008 if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
7009 TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
7012 if Header.ImageID <> 0 then // skip image ID
7013 aStream.Position := aStream.Position + Header.ImageID;
7016 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
7017 0: tgaFormat := tfLuminance8;
7018 8: tgaFormat := tfAlpha8;
7021 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
7022 0: tgaFormat := tfLuminance16;
7023 8: tgaFormat := tfLuminance8Alpha8;
7024 end else case (Header.ImageDesc and $F) of
7025 0: tgaFormat := tfBGR5;
7026 1: tgaFormat := tfBGR5A1;
7027 4: tgaFormat := tfBGRA4;
7030 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7031 0: tgaFormat := tfBGR8;
7034 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
7035 2: tgaFormat := tfBGR10A2;
7036 8: tgaFormat := tfBGRA8;
7040 if (tgaFormat = tfEmpty) then
7041 raise EglBitmapException.Create('LoadTga - unsupported format');
7043 FormatDesc := TFormatDescriptor.Get(tgaFormat);
7044 PixelSize := FormatDesc.GetSize(1, 1);
7045 LineSize := FormatDesc.GetSize(Header.Width, 1);
7047 GetMem(ImageData, LineSize * Header.Height);
7050 if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
7051 Counter.X.low := Header.Height-1;;
7052 Counter.X.high := 0;
7053 Counter.X.dir := -1;
7056 Counter.X.high := Header.Height-1;
7061 if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
7063 Counter.Y.high := Header.Height-1;
7066 Counter.Y.low := Header.Height-1;;
7067 Counter.Y.high := 0;
7068 Counter.Y.dir := -1;
7072 case Header.ImageType of
7073 TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
7075 TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
7079 SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
7086 aStream.Position := StartPosition;
7089 else aStream.Position := StartPosition;
7092 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7093 procedure TglBitmap.SaveTGA(const aStream: TStream);
7096 LineSize, Size, x, y: Integer;
7097 Pixel: TglBitmapPixelData;
7098 LineBuf, SourceData, DestData: PByte;
7099 SourceMD, DestMD: Pointer;
7100 FormatDesc: TFormatDescriptor;
7101 Converter: TFormatDescriptor;
7103 if not (ftTGA in FormatGetSupportedFiles(Format)) then
7104 raise EglBitmapUnsupportedFormat.Create(Format);
7107 FillChar(Header{%H-}, SizeOf(Header), 0);
7110 if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7111 tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7112 Header.ImageType := TGA_UNCOMPRESSED_GRAY
7114 Header.ImageType := TGA_UNCOMPRESSED_RGB;
7117 if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7119 else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7120 tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7122 else if (Format in [tfBGR8, tfRGB8]) then
7130 Header.ImageDesc := 1 and $F;
7131 tfRGB10A2, tfBGR10A2:
7132 Header.ImageDesc := 2 and $F;
7134 Header.ImageDesc := 4 and $F;
7135 tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7136 Header.ImageDesc := 8 and $F;
7139 Header.Width := Width;
7140 Header.Height := Height;
7141 Header.ImageDesc := Header.ImageDesc or $20; //flip y
7142 aStream.Write(Header, SizeOf(Header));
7144 // convert RGB(A) to BGR(A)
7146 FormatDesc := TFormatDescriptor.Get(Format);
7147 Size := FormatDesc.GetSize(Dimension);
7148 if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7149 if (FormatDesc.RGBInverted = tfEmpty) then
7150 raise EglBitmapException.Create('inverted RGB format is empty');
7151 Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7152 if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7153 (Converter.PixelSize <> FormatDesc.PixelSize) then
7154 raise EglBitmapException.Create('invalid inverted RGB format');
7157 if Assigned(Converter) then begin
7158 LineSize := FormatDesc.GetSize(Width, 1);
7159 LineBuf := GetMem(LineSize);
7160 SourceMD := FormatDesc.CreateMappingData;
7161 DestMD := Converter.CreateMappingData;
7164 for y := 0 to Height-1 do begin
7165 DestData := LineBuf;
7166 for x := 0 to Width-1 do begin
7167 FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7168 Converter.Map(Pixel, DestData, DestMD);
7170 aStream.Write(LineBuf^, LineSize);
7174 FormatDesc.FreeMappingData(SourceMD);
7175 FormatDesc.FreeMappingData(DestMD);
7178 aStream.Write(Data^, Size);
7181 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7182 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7183 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7185 DDS_MAGIC: Cardinal = $20534444;
7187 // DDS_header.dwFlags
7188 DDSD_CAPS = $00000001;
7189 DDSD_HEIGHT = $00000002;
7190 DDSD_WIDTH = $00000004;
7191 DDSD_PIXELFORMAT = $00001000;
7193 // DDS_header.sPixelFormat.dwFlags
7194 DDPF_ALPHAPIXELS = $00000001;
7195 DDPF_ALPHA = $00000002;
7196 DDPF_FOURCC = $00000004;
7197 DDPF_RGB = $00000040;
7198 DDPF_LUMINANCE = $00020000;
7200 // DDS_header.sCaps.dwCaps1
7201 DDSCAPS_TEXTURE = $00001000;
7203 // DDS_header.sCaps.dwCaps2
7204 DDSCAPS2_CUBEMAP = $00000200;
7206 D3DFMT_DXT1 = $31545844;
7207 D3DFMT_DXT3 = $33545844;
7208 D3DFMT_DXT5 = $35545844;
7211 TDDSPixelFormat = packed record
7215 dwRGBBitCount: Cardinal;
7216 dwRBitMask: Cardinal;
7217 dwGBitMask: Cardinal;
7218 dwBBitMask: Cardinal;
7219 dwABitMask: Cardinal;
7222 TDDSCaps = packed record
7226 dwReserved: Cardinal;
7229 TDDSHeader = packed record
7234 dwPitchOrLinearSize: Cardinal;
7236 dwMipMapCount: Cardinal;
7237 dwReserved: array[0..10] of Cardinal;
7238 PixelFormat: TDDSPixelFormat;
7240 dwReserved2: Cardinal;
7243 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7244 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7247 Converter: TbmpBitfieldFormat;
7249 function GetDDSFormat: TglBitmapFormat;
7251 fd: TFormatDescriptor;
7253 Range: TglBitmapColorRec;
7257 with Header.PixelFormat do begin
7259 if ((dwFlags and DDPF_FOURCC) > 0) then begin
7260 case Header.PixelFormat.dwFourCC of
7261 D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7262 D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7263 D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7265 end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7267 //find matching format
7268 for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7269 fd := TFormatDescriptor.Get(result);
7270 if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7271 (8 * fd.PixelSize = dwRGBBitCount) then
7275 //find format with same Range
7276 Range.r := dwRBitMask;
7277 Range.g := dwGBitMask;
7278 Range.b := dwBBitMask;
7279 Range.a := dwABitMask;
7280 for i := 0 to 3 do begin
7281 while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7282 Range.arr[i] := Range.arr[i] shr 1;
7284 for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7285 fd := TFormatDescriptor.Get(result);
7288 if (fd.Range.arr[i] <> Range.arr[i]) then begin
7296 //no format with same range found -> use default
7297 if (result = tfEmpty) then begin
7298 if (dwABitMask > 0) then
7304 Converter := TbmpBitfieldFormat.Create;
7305 Converter.RedMask := dwRBitMask;
7306 Converter.GreenMask := dwGBitMask;
7307 Converter.BlueMask := dwBBitMask;
7308 Converter.AlphaMask := dwABitMask;
7309 Converter.PixelSize := dwRGBBitCount / 8;
7316 x, y, LineSize, RowSize, Magic: Cardinal;
7317 NewImage, TmpData, RowData, SrcData: System.PByte;
7318 SourceMD, DestMD: Pointer;
7319 Pixel: TglBitmapPixelData;
7320 ddsFormat: TglBitmapFormat;
7321 FormatDesc: TFormatDescriptor;
7326 StreamPos := aStream.Position;
7329 aStream.Read(Magic{%H-}, sizeof(Magic));
7330 if (Magic <> DDS_MAGIC) then begin
7331 aStream.Position := StreamPos;
7336 aStream.Read(Header{%H-}, sizeof(Header));
7337 if (Header.dwSize <> SizeOf(Header)) or
7338 ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7339 (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7341 aStream.Position := StreamPos;
7345 if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7346 raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
7348 ddsFormat := GetDDSFormat;
7350 if (ddsFormat = tfEmpty) then
7351 raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7353 FormatDesc := TFormatDescriptor.Get(ddsFormat);
7354 LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7355 GetMem(NewImage, Header.dwHeight * LineSize);
7357 TmpData := NewImage;
7360 if Assigned(Converter) then begin
7361 RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7362 GetMem(RowData, RowSize);
7363 SourceMD := Converter.CreateMappingData;
7364 DestMD := FormatDesc.CreateMappingData;
7366 for y := 0 to Header.dwHeight-1 do begin
7367 TmpData := NewImage + y * LineSize;
7369 aStream.Read(SrcData^, RowSize);
7370 for x := 0 to Header.dwWidth-1 do begin
7371 Converter.Unmap(SrcData, Pixel, SourceMD);
7372 glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7373 FormatDesc.Map(Pixel, TmpData, DestMD);
7377 Converter.FreeMappingData(SourceMD);
7378 FormatDesc.FreeMappingData(DestMD);
7384 if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7385 RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7386 for Y := 0 to Header.dwHeight-1 do begin
7387 aStream.Read(TmpData^, RowSize);
7388 Inc(TmpData, LineSize);
7393 if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7394 RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7395 for Y := 0 to Header.dwHeight-1 do begin
7396 aStream.Read(TmpData^, RowSize);
7397 Inc(TmpData, LineSize);
7400 raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7402 SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
7409 FreeAndNil(Converter);
7413 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7414 procedure TglBitmap.SaveDDS(const aStream: TStream);
7417 FormatDesc: TFormatDescriptor;
7419 if not (ftDDS in FormatGetSupportedFiles(Format)) then
7420 raise EglBitmapUnsupportedFormat.Create(Format);
7422 FormatDesc := TFormatDescriptor.Get(Format);
7425 FillChar(Header{%H-}, SizeOf(Header), 0);
7426 Header.dwSize := SizeOf(Header);
7427 Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7429 Header.dwWidth := Max(1, Width);
7430 Header.dwHeight := Max(1, Height);
7433 Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7436 Header.PixelFormat.dwSize := sizeof(Header);
7437 if (FormatDesc.IsCompressed) then begin
7438 Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7440 tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7441 tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7442 tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7444 end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7445 Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7446 Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7447 Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
7448 end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7449 Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7450 Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7451 Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
7452 Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
7454 Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7455 Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7456 Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
7457 Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
7458 Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
7459 Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
7462 if (FormatDesc.HasAlpha) then
7463 Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7465 aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7466 aStream.Write(Header, SizeOf(Header));
7467 aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7470 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7471 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7472 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7473 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7475 if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7476 result := fLines[aIndex]
7481 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7482 procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
7483 const aWidth: Integer; const aHeight: Integer);
7485 Idx, LineWidth: Integer;
7487 inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7489 if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7491 if Assigned(Data) then begin
7492 SetLength(fLines, GetHeight);
7493 LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7495 for Idx := 0 to GetHeight-1 do begin
7496 fLines[Idx] := Data;
7497 Inc(fLines[Idx], Idx * LineWidth);
7500 else SetLength(fLines, 0);
7502 SetLength(fLines, 0);
7506 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7507 procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
7509 FormatDesc: TFormatDescriptor;
7511 glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7513 FormatDesc := TFormatDescriptor.Get(Format);
7514 if FormatDesc.IsCompressed then begin
7515 glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7516 end else if aBuildWithGlu then begin
7517 gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7518 FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7520 glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7521 FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7525 if (FreeDataAfterGenTexture) then
7529 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7530 procedure TglBitmap2D.AfterConstruction;
7533 Target := GL_TEXTURE_2D;
7536 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7537 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7540 Size, w, h: Integer;
7541 FormatDesc: TFormatDescriptor;
7543 FormatDesc := TFormatDescriptor.Get(Format);
7544 if FormatDesc.IsCompressed then
7545 raise EglBitmapUnsupportedFormat.Create(Format);
7547 w := aRight - aLeft;
7548 h := aBottom - aTop;
7549 Size := FormatDesc.GetSize(w, h);
7552 glPixelStorei(GL_PACK_ALIGNMENT, 1);
7553 glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7554 SetDataPointer(Temp, Format, w, h);
7562 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7563 procedure TglBitmap2D.GetDataFromTexture;
7566 TempWidth, TempHeight: Integer;
7567 TempIntFormat: Cardinal;
7568 IntFormat, f: TglBitmapFormat;
7569 FormatDesc: TFormatDescriptor;
7574 glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
7575 glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
7576 glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7578 IntFormat := tfEmpty;
7579 for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7580 FormatDesc := TFormatDescriptor.Get(f);
7581 if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7582 IntFormat := FormatDesc.Format;
7587 // Getting data from OpenGL
7588 FormatDesc := TFormatDescriptor.Get(IntFormat);
7589 GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
7591 if FormatDesc.IsCompressed then
7592 glGetCompressedTexImage(Target, 0, Temp)
7594 glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
7595 SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
7602 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7603 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
7605 BuildWithGlu, PotTex, TexRec: Boolean;
7608 if Assigned(Data) then begin
7609 // Check Texture Size
7610 if (aTestTextureSize) then begin
7611 glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7613 if ((Height > TexSize) or (Width > TexSize)) then
7614 raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7616 PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
7617 TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
7619 if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7620 raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7624 SetupParameters(BuildWithGlu);
7625 UploadData(Target, BuildWithGlu);
7626 glAreTexturesResident(1, @fID, @fIsResident);
7630 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7631 function TglBitmap2D.FlipHorz: Boolean;
7634 TempDestData, DestData, SourceData: PByte;
7637 result := inherited FlipHorz;
7638 if Assigned(Data) then begin
7640 ImgSize := Height * fRowSize;
7641 GetMem(DestData, ImgSize);
7643 TempDestData := DestData;
7644 Dec(TempDestData, fRowSize + fPixelSize);
7645 for Row := 0 to Height -1 do begin
7646 Inc(TempDestData, fRowSize * 2);
7647 for Col := 0 to Width -1 do begin
7648 Move(SourceData^, TempDestData^, fPixelSize);
7649 Inc(SourceData, fPixelSize);
7650 Dec(TempDestData, fPixelSize);
7653 SetDataPointer(DestData, Format);
7662 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7663 function TglBitmap2D.FlipVert: Boolean;
7666 TempDestData, DestData, SourceData: PByte;
7668 result := inherited FlipVert;
7669 if Assigned(Data) then begin
7671 GetMem(DestData, Height * fRowSize);
7673 TempDestData := DestData;
7674 Inc(TempDestData, Width * (Height -1) * fPixelSize);
7675 for Row := 0 to Height -1 do begin
7676 Move(SourceData^, TempDestData^, fRowSize);
7677 Dec(TempDestData, fRowSize);
7678 Inc(SourceData, fRowSize);
7680 SetDataPointer(DestData, Format);
7689 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7690 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7691 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7693 TMatrixItem = record
7698 PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7699 TglBitmapToNormalMapRec = Record
7701 Heights: array of Single;
7702 MatrixU : array of TMatrixItem;
7703 MatrixV : array of TMatrixItem;
7707 ONE_OVER_255 = 1 / 255;
7709 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7710 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7714 with FuncRec do begin
7716 Source.Data.r * LUMINANCE_WEIGHT_R +
7717 Source.Data.g * LUMINANCE_WEIGHT_G +
7718 Source.Data.b * LUMINANCE_WEIGHT_B;
7719 PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7723 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7724 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7727 PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7730 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7731 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7733 TVec = Array[0..2] of Single;
7740 function GetHeight(X, Y: Integer): Single;
7742 with FuncRec do begin
7743 X := Max(0, Min(Size.X -1, X));
7744 Y := Max(0, Min(Size.Y -1, Y));
7745 result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7750 with FuncRec do begin
7751 with PglBitmapToNormalMapRec(Args)^ do begin
7753 for Idx := Low(MatrixU) to High(MatrixU) do
7754 du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7757 for Idx := Low(MatrixU) to High(MatrixU) do
7758 dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7760 Vec[0] := -du * Scale;
7761 Vec[1] := -dv * Scale;
7766 Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7767 if Len <> 0 then begin
7768 Vec[0] := Vec[0] * Len;
7769 Vec[1] := Vec[1] * Len;
7770 Vec[2] := Vec[2] * Len;
7774 Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7775 Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7776 Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7780 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7781 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7783 Rec: TglBitmapToNormalMapRec;
7785 procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7787 if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7788 Matrix[Index].X := X;
7789 Matrix[Index].Y := Y;
7790 Matrix[Index].W := W;
7795 if TFormatDescriptor.Get(Format).IsCompressed then
7796 raise EglBitmapUnsupportedFormat.Create(Format);
7798 if aScale > 100 then
7800 else if aScale < -100 then
7803 Rec.Scale := aScale;
7805 SetLength(Rec.Heights, Width * Height);
7809 SetLength(Rec.MatrixU, 2);
7810 SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
7811 SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
7813 SetLength(Rec.MatrixV, 2);
7814 SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
7815 SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
7819 SetLength(Rec.MatrixU, 6);
7820 SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
7821 SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
7822 SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7823 SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
7824 SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
7825 SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
7827 SetLength(Rec.MatrixV, 6);
7828 SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
7829 SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
7830 SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
7831 SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7832 SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
7833 SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
7837 SetLength(Rec.MatrixU, 6);
7838 SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
7839 SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
7840 SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7841 SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
7842 SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
7843 SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
7845 SetLength(Rec.MatrixV, 6);
7846 SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
7847 SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
7848 SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
7849 SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7850 SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
7851 SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
7855 SetLength(Rec.MatrixU, 20);
7856 SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
7857 SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
7858 SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
7859 SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
7860 SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
7861 SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
7862 SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
7863 SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
7864 SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
7865 SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
7866 SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
7867 SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
7868 SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7869 SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
7870 SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
7871 SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
7872 SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7873 SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7874 SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
7875 SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
7877 SetLength(Rec.MatrixV, 20);
7878 SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
7879 SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
7880 SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
7881 SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
7882 SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
7883 SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
7884 SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
7885 SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
7886 SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
7887 SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
7888 SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7889 SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
7890 SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
7891 SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
7892 SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
7893 SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7894 SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7895 SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
7896 SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
7897 SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
7902 if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7903 AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
7905 AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
7906 AddFunc(glBitmapToNormalMapFunc, false, @Rec);
7908 SetLength(Rec.Heights, 0);
7921 procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
7926 if Height > 1 then begin
7927 // extract first line of the data
7928 Size := FormatGetImageSize(glBitmapPosition(Width), Format);
7929 GetMem(pTemp, Size);
7931 Move(Data^, pTemp^, Size);
7938 inherited SetDataPointer(pTemp, Format, Width);
7940 if FormatIsUncompressed(Format) then begin
7941 fUnmapFunc := FormatGetUnMapFunc(Format);
7942 fGetPixelFunc := GetPixel1DUnmap;
7947 procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
7952 Inc(pTemp, Pos.X * fPixelSize);
7954 fUnmapFunc(pTemp, Pixel);
7958 function TglBitmap1D.FlipHorz: Boolean;
7961 pTempDest, pDest, pSource: pByte;
7963 result := inherited FlipHorz;
7965 if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
7968 GetMem(pDest, fRowSize);
7972 Inc(pTempDest, fRowSize);
7973 for Col := 0 to Width -1 do begin
7974 Move(pSource^, pTempDest^, fPixelSize);
7976 Inc(pSource, fPixelSize);
7977 Dec(pTempDest, fPixelSize);
7980 SetDataPointer(pDest, InternalFormat);
7990 procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
7993 if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
7994 glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
7998 if BuildWithGlu then
7999 gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
8001 glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
8004 if (FreeDataAfterGenTexture) then
8009 procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
8011 BuildWithGlu, TexRec: Boolean;
8012 glFormat, glInternalFormat, glType: Cardinal;
8015 if Assigned(Data) then begin
8016 // Check Texture Size
8017 if (TestTextureSize) then begin
8018 glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
8020 if (Width > TexSize) then
8021 raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
8023 TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
8024 (Target = GL_TEXTURE_RECTANGLE_ARB);
8026 if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
8027 raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
8032 SetupParameters(BuildWithGlu);
8033 SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
8035 UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
8038 glAreTexturesResident(1, @fID, @fIsResident);
8043 procedure TglBitmap1D.AfterConstruction;
8047 Target := GL_TEXTURE_1D;
8051 { TglBitmapCubeMap }
8053 procedure TglBitmapCubeMap.AfterConstruction;
8057 if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
8058 raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
8060 SetWrap; // set all to GL_CLAMP_TO_EDGE
8061 Target := GL_TEXTURE_CUBE_MAP;
8062 fGenMode := GL_REFLECTION_MAP;
8066 procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
8068 inherited Bind (EnableTextureUnit);
8070 if EnableTexCoordsGen then begin
8071 glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8072 glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8073 glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8074 glEnable(GL_TEXTURE_GEN_S);
8075 glEnable(GL_TEXTURE_GEN_T);
8076 glEnable(GL_TEXTURE_GEN_R);
8081 procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
8083 glFormat, glInternalFormat, glType: Cardinal;
8084 BuildWithGlu: Boolean;
8087 // Check Texture Size
8088 if (TestTextureSize) then begin
8089 glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8091 if ((Height > TexSize) or (Width > TexSize)) then
8092 raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8094 if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8095 raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8099 if ID = 0 then begin
8101 SetupParameters(BuildWithGlu);
8104 SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
8106 UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
8110 procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
8112 Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8116 procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
8117 DisableTextureUnit: Boolean);
8119 inherited Unbind (DisableTextureUnit);
8121 if DisableTexCoordsGen then begin
8122 glDisable(GL_TEXTURE_GEN_S);
8123 glDisable(GL_TEXTURE_GEN_T);
8124 glDisable(GL_TEXTURE_GEN_R);
8129 { TglBitmapNormalMap }
8132 TVec = Array[0..2] of Single;
8133 TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8135 PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8136 TglBitmapNormalMapRec = record
8138 Func: TglBitmapNormalMapGetVectorFunc;
8142 procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8145 Vec[1] := - (Position.Y + 0.5 - HalfSize);
8146 Vec[2] := - (Position.X + 0.5 - HalfSize);
8150 procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8152 Vec[0] := - HalfSize;
8153 Vec[1] := - (Position.Y + 0.5 - HalfSize);
8154 Vec[2] := Position.X + 0.5 - HalfSize;
8158 procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8160 Vec[0] := Position.X + 0.5 - HalfSize;
8162 Vec[2] := Position.Y + 0.5 - HalfSize;
8166 procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8168 Vec[0] := Position.X + 0.5 - HalfSize;
8169 Vec[1] := - HalfSize;
8170 Vec[2] := - (Position.Y + 0.5 - HalfSize);
8174 procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8176 Vec[0] := Position.X + 0.5 - HalfSize;
8177 Vec[1] := - (Position.Y + 0.5 - HalfSize);
8182 procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8184 Vec[0] := - (Position.X + 0.5 - HalfSize);
8185 Vec[1] := - (Position.Y + 0.5 - HalfSize);
8186 Vec[2] := - HalfSize;
8190 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8195 with FuncRec do begin
8196 with PglBitmapNormalMapRec (CustomData)^ do begin
8197 Func(Vec, Position, HalfSize);
8200 Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8201 if Len <> 0 then begin
8202 Vec[0] := Vec[0] * Len;
8203 Vec[1] := Vec[1] * Len;
8204 Vec[2] := Vec[2] * Len;
8207 // Scale Vector and AddVectro
8208 Vec[0] := Vec[0] * 0.5 + 0.5;
8209 Vec[1] := Vec[1] * 0.5 + 0.5;
8210 Vec[2] := Vec[2] * 0.5 + 0.5;
8214 Dest.Red := Round(Vec[0] * 255);
8215 Dest.Green := Round(Vec[1] * 255);
8216 Dest.Blue := Round(Vec[2] * 255);
8221 procedure TglBitmapNormalMap.AfterConstruction;
8225 fGenMode := GL_NORMAL_MAP;
8229 procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
8230 TestTextureSize: Boolean);
8232 Rec: TglBitmapNormalMapRec;
8233 SizeRec: TglBitmapPixelPosition;
8235 Rec.HalfSize := Size div 2;
8237 FreeDataAfterGenTexture := false;
8239 SizeRec.Fields := [ffX, ffY];
8244 Rec.Func := glBitmapNormalMapPosX;
8245 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8246 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
8249 Rec.Func := glBitmapNormalMapNegX;
8250 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8251 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
8254 Rec.Func := glBitmapNormalMapPosY;
8255 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8256 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
8259 Rec.Func := glBitmapNormalMapNegY;
8260 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8261 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
8264 Rec.Func := glBitmapNormalMapPosZ;
8265 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8266 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
8269 Rec.Func := glBitmapNormalMapNegZ;
8270 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8271 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
8276 glBitmapSetDefaultFormat(tfEmpty);
8277 glBitmapSetDefaultMipmap(mmMipmap);
8278 glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8279 glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8281 glBitmapSetDefaultFreeDataAfterGenTexture(true);
8282 glBitmapSetDefaultDeleteTextureOnFree (true);
8284 TFormatDescriptor.Init;
8286 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8287 OpenGLInitialized := false;
8288 InitOpenGLCS := TCriticalSection.Create;
8292 TFormatDescriptor.Finalize;
8294 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8295 FreeAndNil(InitOpenGLCS);