1 {***********************************************************
2 glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
3 http://www.opengl24.de/index.php?cat=header&file=glbitmap
4 ------------------------------------------------------------
5 The contents of this file are used with permission, subject to
6 the Mozilla Public License Version 1.1 (the "License"); you may
7 not use this file except in compliance with the License. You may
8 obtain a copy of the License at
9 http://www.mozilla.org/MPL/MPL-1.1.html
10 ------------------------------------------------------------
12 ------------------------------------------------------------
15 - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
16 then it's your problem if that isn't true. This prevents the unit for incompatibility
17 with newer versions of Delphi.
18 - Problems with D2009+ resolved (Thanks noeska and all i forgot)
19 - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
21 - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
22 - Additional Datapointer for functioninterface now has the name CustomData
24 - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
25 - If you load an texture from an file the property Filename will be set to the name of the file
26 - Three new properties to attach custom data to the Texture objects
27 - CustomName (free for use string)
28 - CustomNameW (free for use widestring)
29 - CustomDataPointer (free for use pointer to attach other objects or complex structures)
31 - RLE TGAs loaded much faster
33 - fixed some problem with reading RLE TGAs.
35 - function clone now only copys data if it's assigned and now it also copies the ID
36 - it seems that lazarus dont like comments in comments.
38 - It's possible to set the id of the texture
39 - define GLB_NO_NATIVE_GL deactivated by default
41 - Now supports the following libraries
45 - Linux compatibillity via free pascal compatibility (delphi sources optional)
46 - BMPs now loaded manuel
48 - Property DataPtr now has the name Data
49 - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
50 - Unused Depth removed
51 - Function FreeData to freeing image data added
53 - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
55 - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
56 - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
57 - Function ReadOpenGLExtension is now only intern
59 - pngimage now disabled by default like all other versions.
61 - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
63 - Fixed some Problem with Delphi 5
64 - Now uses the newest version of pngimage. Makes saving pngs much easier.
66 - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
68 - Internal Format ifDepth8 added
69 - function GrabScreen now supports all uncompressed formats
71 - AddAlphaFromglBitmap implemented
73 - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
75 - Width, Height and Depth internal changed to TglBitmapPixelPosition.
76 property Width, Height, Depth are still existing and new property Dimension are avail
78 - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
80 - Added function GrabScreen to class TglBitmap2D
82 - Added support to Save images
83 - Added function Clone to Clone Instance
85 - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
87 - Several speed optimizations
89 - Internal structure change. Loading of TGA, PNG and DDS improved.
90 Data, format and size will now set directly with SetDataPtr.
91 - AddFunc now works with all Types of Images and Formats
92 - Some Funtions moved to Baseclass TglBitmap
94 - Added Support to decompress DXT3 and DXT5 compressed Images.
95 - Added Mapping to convert data from one format into an other.
97 - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
98 supported Input format (supported by GetPixel) into any uncompresed Format
99 - Added Support to decompress DXT1 compressed Images.
100 - SwapColors replaced by ConvertTo
102 - Added Support for compressed DDSs
103 - Added new internal formats (DXT1, DXT3, DXT5)
105 - Parameter Components renamed to InternalFormat
107 - Some AllocMem replaced with GetMem (little speed change)
108 - better exception handling. Better protection from memory leaks.
110 - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
111 - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
113 - Added support for Grayscale textures
114 - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
116 - Added support for GL_VERSION_2_0
117 - Added support for GL_EXT_texture_filter_anisotropic
119 - Function FillWithColor fills the Image with one Color
120 - Function LoadNormalMap added
122 - ToNormalMap allows to Create an NormalMap from the Alphachannel
123 - ToNormalMap now supports Sobel (nmSobel) function.
125 - support for RLE Compressed RGB TGAs added
127 - Class TglBitmapNormalMap added to support Normalmap generation
128 - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
129 3 Filters are supported. (4 Samples, 3x3 and 5x5)
131 - Method LoadCubeMapClass removed
132 - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
133 - virtual abstract method GenTexture in class TglBitmap now is protected
135 - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
137 - little enhancement for IsPowerOfTwo
138 - TglBitmap1D.GenTexture now tests NPOT Textures
140 - some little name changes. All properties or function with Texture in name are
141 now without texture in name. We have allways texture so we dosn't name it.
143 - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
144 TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
146 - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
148 - Function Unbind added
149 - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
151 - class TglBitmapCubeMap added (allows to Create Cubemaps)
153 - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
154 To Enable png's use the define pngimage
156 - New Functioninterface added
157 - Function GetPixel added
159 - Property BuildMipMaps renamed to MipMap
161 - property Name removed.
162 - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
164 - property name added. Only used in glForms!
166 - property FreeDataAfterGenTexture is now available as default (default = true)
167 - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
168 - function MoveMemory replaced with function Move (little speed change)
169 - several calculations stored in variables (little speed change)
171 - property BuildMipsMaps added (default = true)
172 if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
173 - property FreeDataAfterGenTexture added (default = true)
174 if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
175 - parameter DisableOtherTextureUnits of Bind removed
176 - parameter FreeDataAfterGeneration of GenTextures removed
178 - TglBitmap dosn't delete data if class was destroyed (fixed)
180 - Bind now enables TextureUnits (by params)
181 - GenTextures can leave data (by param)
182 - LoadTextures now optimal
184 - Performance optimization in AddFunc
185 - procedure Bind moved to subclasses
186 - Added new Class TglBitmap1D to support real OpenGL 1D Textures
188 - Texturefilter and texturewrap now also as defaults
189 Minfilter = GL_LINEAR_MIPMAP_LINEAR
190 Magfilter = GL_LINEAR
191 Wrap(str) = GL_CLAMP_TO_EDGE
192 - Added new format tfCompressed to create a compressed texture.
193 - propertys IsCompressed, TextureSize and IsResident added
194 IsCompressed and TextureSize only contains data from level 0
196 - Added function AddFunc to add PerPixelEffects to Image
197 - LoadFromFunc now based on AddFunc
198 - Invert now based on AddFunc
199 - SwapColors now based on AddFunc
201 - Added function FlipHorz
203 - Added function LaodFromFunc to create images with function
204 - Added function FlipVert
205 - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
207 - Added Alphafunctions to calculate alpha per function
208 - Added Alpha from ColorKey using alphafunctions
210 - First full functionally Version of glBitmap
211 - Support for 24Bit and 32Bit TGA Pictures added
213 - begin of programming
214 ***********************************************************}
217 {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
218 // Please uncomment the defines below to configure the glBitmap to your preferences.
219 // If you have configured the unit you can uncomment the warning above.
221 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
222 // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
223 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
224 // activate to enable build-in OpenGL support with statically linked methods
225 // use dglOpenGL.pas if not enabled
226 {.$DEFINE GLB_NATIVE_OGL_STATIC}
228 // activate to enable build-in OpenGL support with dynamically linked methods
229 // use dglOpenGL.pas if not enabled
230 {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
232 // activate to enable the support for SDL_surfaces
235 // activate to enable the support for TBitmap from Delphi (not lazarus)
236 {.$DEFINE GLB_DELPHI}
239 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
240 // activate to enable the support of SDL_image to load files. (READ ONLY)
241 // If you enable SDL_image all other libraries will be ignored!
242 {$DEFINE GLB_SDL_IMAGE}
244 // activate to enable png support with the unit pngimage. You can download it from http://pngdelphi.sourceforge.net/
245 // if you enable pngimage the libPNG will be ignored
246 {.$DEFINE GLB_PNGIMAGE}
248 // activate to use the libPNG http://www.libpng.org/
249 // You will need an aditional header.
250 // http://www.opengl24.de/index.php?cat=header&file=libpng
251 {.$DEFINE GLB_LIB_PNG}
253 // if you enable delphi jpegs the libJPEG will be ignored
254 {.$DEFINE GLB_DELPHI_JPEG}
256 // activateto use the libJPEG http://www.ijg.org/
257 // You will need an aditional header.
258 // http://www.opengl24.de/index.php?cat=header&file=libjpeg
259 {.$DEFINE GLB_LIB_JPEG}
262 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
263 // PRIVATE: DO not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
264 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
280 {$IF DEFINED(WIN32) or DEFINED(WIN64)}
282 {$ELSEIF DEFINED(LINUX)}
286 // native OpenGL Support
287 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
288 {$DEFINE GLB_NATIVE_OGL}
291 // checking define combinations
293 {$IFDEF GLB_SDL_IMAGE}
295 {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
298 {$IFDEF GLB_PNGIMAGE}
299 {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
300 {$undef GLB_PNGIMAGE}
302 {$IFDEF GLB_DELPHI_JPEG}
303 {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
304 {$undef GLB_DELPHI_JPEG}
307 {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
310 {$IFDEF GLB_LIB_JPEG}
311 {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
312 {$undef GLB_LIB_JPEG}
315 {$DEFINE GLB_SUPPORT_PNG_READ}
316 {$DEFINE GLB_SUPPORT_JPEG_READ}
320 {$IFDEF GLB_PNGIMAGE}
322 {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
326 {$DEFINE GLB_SUPPORT_PNG_READ}
327 {$DEFINE GLB_SUPPORT_PNG_WRITE}
332 {$DEFINE GLB_SUPPORT_PNG_READ}
333 {$DEFINE GLB_SUPPORT_PNG_WRITE}
337 {$IFDEF GLB_DELPHI_JPEG}
338 {$IFDEF GLB_LIB_JPEG}
339 {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
340 {$undef GLB_LIB_JPEG}
343 {$DEFINE GLB_SUPPORT_JPEG_READ}
344 {$DEFINE GLB_SUPPORT_JPEG_WRITE}
348 {$IFDEF GLB_LIB_JPEG}
349 {$DEFINE GLB_SUPPORT_JPEG_READ}
350 {$DEFINE GLB_SUPPORT_JPEG_WRITE}
354 {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
355 {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
369 {$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
370 {$IF DEFINED(GLB_WIN) AND
371 DEFINED(GLB_NATIVE_OGL)} windows, {$IFEND}
373 {$IFDEF GLB_SDL} SDL, {$ENDIF}
374 {$IFDEF GLB_DELPHI} Dialogs, Graphics, {$ENDIF}
376 {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
378 {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
379 {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
381 {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
382 {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
392 TRGBQuad = packed record
400 {$IFDEF GLB_NATIVE_OGL}
406 GL_EXTENSIONS = $1F03;
408 GL_TEXTURE_1D = $0DE0;
409 GL_TEXTURE_2D = $0DE1;
410 GL_TEXTURE_RECTANGLE = $84F5;
412 GL_TEXTURE_WIDTH = $1000;
413 GL_TEXTURE_HEIGHT = $1001;
414 GL_TEXTURE_INTERNAL_FORMAT = $1003;
422 GL_LUMINANCE = $1909;
423 GL_LUMINANCE4 = $803F;
424 GL_LUMINANCE8 = $8040;
425 GL_LUMINANCE12 = $8041;
426 GL_LUMINANCE16 = $8042;
428 GL_LUMINANCE_ALPHA = $190A;
429 GL_LUMINANCE4_ALPHA4 = $8043;
430 GL_LUMINANCE6_ALPHA2 = $8044;
431 GL_LUMINANCE8_ALPHA8 = $8045;
432 GL_LUMINANCE12_ALPHA4 = $8046;
433 GL_LUMINANCE12_ALPHA12 = $8047;
434 GL_LUMINANCE16_ALPHA16 = $8048;
457 GL_DEPTH_COMPONENT = $1902;
458 GL_DEPTH_COMPONENT16 = $81A5;
459 GL_DEPTH_COMPONENT24 = $81A6;
460 GL_DEPTH_COMPONENT32 = $81A7;
462 GL_COMPRESSED_RGB = $84ED;
463 GL_COMPRESSED_RGBA = $84EE;
464 GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
465 GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
466 GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
467 GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
469 GL_UNSIGNED_BYTE = $1401;
470 GL_UNSIGNED_BYTE_3_3_2 = $8032;
471 GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
473 GL_UNSIGNED_SHORT = $1403;
474 GL_UNSIGNED_SHORT_5_6_5 = $8363;
475 GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
476 GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
477 GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
478 GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
479 GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
481 GL_UNSIGNED_INT = $1405;
482 GL_UNSIGNED_INT_8_8_8_8 = $8035;
483 GL_UNSIGNED_INT_10_10_10_2 = $8036;
484 GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
485 GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
488 GL_TEXTURE_MAG_FILTER = $2800;
489 GL_TEXTURE_MIN_FILTER = $2801;
491 GL_NEAREST_MIPMAP_NEAREST = $2700;
492 GL_NEAREST_MIPMAP_LINEAR = $2702;
494 GL_LINEAR_MIPMAP_NEAREST = $2701;
495 GL_LINEAR_MIPMAP_LINEAR = $2703;
498 GL_TEXTURE_WRAP_S = $2802;
499 GL_TEXTURE_WRAP_T = $2803;
500 GL_TEXTURE_WRAP_R = $8072;
503 GL_CLAMP_TO_EDGE = $812F;
504 GL_CLAMP_TO_BORDER = $812D;
505 GL_MIRRORED_REPEAT = $8370;
508 GL_GENERATE_MIPMAP = $8191;
509 GL_TEXTURE_BORDER_COLOR = $1004;
510 GL_MAX_TEXTURE_SIZE = $0D33;
511 GL_PACK_ALIGNMENT = $0D05;
512 GL_UNPACK_ALIGNMENT = $0CF5;
514 GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
515 GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
518 libglu = 'libGLU.so.1';
519 libopengl = 'libGL.so.1';
521 libglu = 'glu32.dll';
522 libopengl = 'opengl32.dll';
526 GLboolean = BYTEBOOL;
534 PGLboolean = ^GLboolean;
539 TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
540 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}
541 TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
543 {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
544 TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
545 TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
547 TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
548 TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
550 TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
551 TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
552 TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
553 TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
554 TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
555 TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
557 TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
558 TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
559 TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
561 TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
562 TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
563 TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
565 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}
566 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}
567 TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
569 TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
570 TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
573 TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
575 TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
578 {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
579 procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
580 procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
582 function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
583 procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
585 procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
586 procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
587 procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
588 procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
589 procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
590 procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
592 procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
593 procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
594 procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
596 function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
597 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;
598 procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
600 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;
601 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;
602 procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
604 function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
605 function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
614 GL_SGIS_generate_mipmap,
616 GL_ARB_texture_border_clamp,
617 GL_ARB_texture_mirrored_repeat,
618 GL_ARB_texture_rectangle,
619 GL_ARB_texture_non_power_of_two,
621 GL_IBM_texture_mirrored_repeat,
623 GL_NV_texture_rectangle,
625 GL_EXT_texture_edge_clamp,
626 GL_EXT_texture_rectangle,
627 GL_EXT_texture_filter_anisotropic: Boolean;
629 glCompressedTexImage1D: TglCompressedTexImage1D;
630 glCompressedTexImage2D: TglCompressedTexImage2D;
631 glGetCompressedTexImage: TglGetCompressedTexImage;
633 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
635 glDisable: TglDisable;
637 glGetString: TglGetString;
638 glGetIntegerv: TglGetIntegerv;
640 glTexParameteri: TglTexParameteri;
641 glTexParameterfv: TglTexParameterfv;
642 glGetTexParameteriv: TglGetTexParameteriv;
643 glGetTexParameterfv: TglGetTexParameterfv;
644 glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
645 glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
647 glGenTextures: TglGenTextures;
648 glBindTexture: TglBindTexture;
649 glDeleteTextures: TglDeleteTextures;
651 glAreTexturesResident: TglAreTexturesResident;
652 glReadPixels: TglReadPixels;
653 glPixelStorei: TglPixelStorei;
655 glTexImage1D: TglTexImage1D;
656 glTexImage2D: TglTexImage2D;
657 glGetTexImage: TglGetTexImage;
659 gluBuild1DMipmaps: TgluBuild1DMipmaps;
660 gluBuild2DMipmaps: TgluBuild2DMipmaps;
662 {$IF DEFINED(GLB_WIN)}
663 wglGetProcAddress: TwglGetProcAddress;
664 {$ELSEIF DEFINED(GLB_LINUX)}
665 glXGetProcAddress: TglXGetProcAddress;
666 glXGetProcAddressARB: TglXGetProcAddressARB;
680 ////////////////////////////////////////////////////////////////////////////////////////////////////
681 EglBitmapException = class(Exception);
682 EglBitmapSizeToLargeException = class(EglBitmapException);
683 EglBitmapNonPowerOfTwoException = class(EglBitmapException);
684 EglBitmapUnsupportedFormat = class(EglBitmapException);
686 ////////////////////////////////////////////////////////////////////////////////////////////////////
688 tfEmpty = 0, //must be smallest value!
704 tfLuminance12Alpha12,
705 tfLuminance16Alpha16,
749 TglBitmapFileType = (
750 {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
751 {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
755 TglBitmapFileTypes = set of TglBitmapFileType;
762 TglBitmapNormalMapFunc = (
768 ////////////////////////////////////////////////////////////////////////////////////////////////////
769 TglBitmapColorRec = packed record
771 0: (r, g, b, a: Cardinal);
772 1: (arr: array[0..3] of Cardinal);
775 TglBitmapPixelData = packed record
776 Data, Range: TglBitmapColorRec;
777 Format: TglBitmapFormat;
779 PglBitmapPixelData = ^TglBitmapPixelData;
781 ////////////////////////////////////////////////////////////////////////////////////////////////////
782 TglBitmapPixelPositionFields = set of (ffX, ffY);
783 TglBitmapPixelPosition = record
784 Fields : TglBitmapPixelPositionFields;
789 ////////////////////////////////////////////////////////////////////////////////////////////////////
791 TglBitmapFunctionRec = record
793 Size: TglBitmapPixelPosition;
794 Position: TglBitmapPixelPosition;
795 Source: TglBitmapPixelData;
796 Dest: TglBitmapPixelData;
799 TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
801 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
806 fAnisotropic: Integer;
807 fDeleteTextureOnFree: Boolean;
808 fFreeDataAfterGenTexture: Boolean;
810 fIsResident: Boolean;
811 fBorderColor: array[0..3] of Single;
813 fDimension: TglBitmapPixelPosition;
814 fMipMap: TglBitmapMipMap;
815 fFormat: TglBitmapFormat;
822 fFilterMin: Cardinal;
823 fFilterMag: Cardinal;
833 fCustomNameW: WideString;
834 fCustomData: Pointer;
837 function GetWidth: Integer; virtual;
838 function GetHeight: Integer; virtual;
840 function GetFileWidth: Integer; virtual;
841 function GetFileHeight: Integer; virtual;
844 procedure SetCustomData(const aValue: Pointer);
845 procedure SetCustomName(const aValue: String);
846 procedure SetCustomNameW(const aValue: WideString);
847 procedure SetDeleteTextureOnFree(const aValue: Boolean);
848 procedure SetFormat(const aValue: TglBitmapFormat);
849 procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
850 procedure SetID(const aValue: Cardinal);
851 procedure SetMipMap(const aValue: TglBitmapMipMap);
852 procedure SetTarget(const aValue: Cardinal);
853 procedure SetAnisotropic(const aValue: Integer);
856 procedure SetupParameters(out aBuildWithGlu: Boolean);
857 procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
858 const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
859 procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
861 function FlipHorz: Boolean; virtual;
862 function FlipVert: Boolean; virtual;
864 property Width: Integer read GetWidth;
865 property Height: Integer read GetHeight;
867 property FileWidth: Integer read GetFileWidth;
868 property FileHeight: Integer read GetFileHeight;
871 property ID: Cardinal read fID write SetID;
872 property Target: Cardinal read fTarget write SetTarget;
873 property Format: TglBitmapFormat read fFormat write SetFormat;
874 property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
875 property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
877 property Filename: String read fFilename;
878 property CustomName: String read fCustomName write SetCustomName;
879 property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
880 property CustomData: Pointer read fCustomData write SetCustomData;
882 property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
883 property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
885 property Dimension: TglBitmapPixelPosition read fDimension;
886 property Data: PByte read fData;
887 property IsResident: Boolean read fIsResident;
889 procedure AfterConstruction; override;
890 procedure BeforeDestruction; override;
893 procedure LoadFromFile(const aFilename: String);
894 procedure LoadFromStream(const aStream: TStream); virtual;
895 procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
896 const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
898 procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
899 procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
903 procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
904 procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
907 function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
908 function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
909 const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
913 function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
914 function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
915 function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
916 function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
917 const aArgs: Pointer = nil): Boolean;
921 function AssignToBitmap(const aBitmap: TBitmap): Boolean;
922 function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
923 function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
924 function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
925 const aArgs: Pointer = nil): Boolean;
926 function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
927 const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
928 function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
929 const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
932 function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
933 function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
934 function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
935 function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
937 function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
938 function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
939 function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
941 function AddAlphaFromValue(const aAlpha: Byte): Boolean;
942 function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
943 function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
945 function RemoveAlpha: Boolean; virtual;
948 function Clone: TglBitmap;
949 function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
950 procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
951 procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
955 procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
956 procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
957 procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
960 procedure SetFilter(const aMin, aMag: Cardinal);
962 const S: Cardinal = GL_CLAMP_TO_EDGE;
963 const T: Cardinal = GL_CLAMP_TO_EDGE;
964 const R: Cardinal = GL_CLAMP_TO_EDGE);
966 procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
967 procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
970 constructor Create; overload;
971 constructor Create(const aFileName: String); overload;
972 constructor Create(const aStream: TStream); overload;
973 constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
974 constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
976 constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
977 constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
980 {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
981 {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
983 {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
984 {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
986 function LoadBMP(const aStream: TStream): Boolean; virtual;
987 procedure SaveBMP(const aStream: TStream); virtual;
989 function LoadTGA(const aStream: TStream): Boolean; virtual;
990 procedure SaveTGA(const aStream: TStream); virtual;
992 function LoadDDS(const aStream: TStream): Boolean; virtual;
993 procedure SaveDDS(const aStream: TStream); virtual;
996 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
997 TglBitmap2D = class(TglBitmap)
1000 fLines: array of PByte;
1003 procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
1004 procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1005 procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1006 procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1007 procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1008 procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
1011 function GetScanline(const aIndex: Integer): Pointer;
1012 procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
1013 const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
1014 procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
1018 property Scanline[const aIndex: Integer]: Pointer read GetScanline;
1020 procedure AfterConstruction; override;
1022 procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
1023 procedure GetDataFromTexture;
1024 procedure GenTexture(const aTestTextureSize: Boolean = true); override;
1026 function FlipHorz: Boolean; override;
1027 function FlipVert: Boolean; override;
1029 procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
1030 const aScale: Single = 2; const aUseAlpha: Boolean = false);
1034 TglBitmapCubeMap = class(TglBitmap2D)
1039 procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
1041 procedure AfterConstruction; override;
1043 procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
1045 procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
1046 procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
1050 TglBitmapNormalMap = class(TglBitmapCubeMap)
1052 procedure AfterConstruction; override;
1054 procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
1058 TglBitmap1D = class(TglBitmap)
1060 procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
1062 procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
1063 procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
1068 procedure AfterConstruction; override;
1071 function FlipHorz: Boolean; override;
1074 procedure GenTexture(TestTextureSize: Boolean = true); override;
1079 NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
1081 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
1082 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
1083 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
1084 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
1085 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
1086 procedure glBitmapSetDefaultWrap(
1087 const S: Cardinal = GL_CLAMP_TO_EDGE;
1088 const T: Cardinal = GL_CLAMP_TO_EDGE;
1089 const R: Cardinal = GL_CLAMP_TO_EDGE);
1091 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1092 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1093 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
1094 function glBitmapGetDefaultFormat: TglBitmapFormat;
1095 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
1096 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
1098 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1099 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1100 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1103 glBitmapDefaultDeleteTextureOnFree: Boolean;
1104 glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1105 glBitmapDefaultFormat: TglBitmapFormat;
1106 glBitmapDefaultMipmap: TglBitmapMipMap;
1107 glBitmapDefaultFilterMin: Cardinal;
1108 glBitmapDefaultFilterMag: Cardinal;
1109 glBitmapDefaultWrapS: Cardinal;
1110 glBitmapDefaultWrapT: Cardinal;
1111 glBitmapDefaultWrapR: Cardinal;
1114 function CreateGrayPalette: HPALETTE;
1121 function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
1122 function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
1123 function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1124 function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
1125 function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
1132 ////////////////////////////////////////////////////////////////////////////////////////////////////
1133 TShiftRec = packed record
1135 0: (r, g, b, a: Byte);
1136 1: (arr: array[0..3] of Byte);
1139 TFormatDescriptor = class(TObject)
1141 function GetRedMask: QWord;
1142 function GetGreenMask: QWord;
1143 function GetBlueMask: QWord;
1144 function GetAlphaMask: QWord;
1146 fFormat: TglBitmapFormat;
1147 fWithAlpha: TglBitmapFormat;
1148 fWithoutAlpha: TglBitmapFormat;
1149 fRGBInverted: TglBitmapFormat;
1150 fUncompressed: TglBitmapFormat;
1152 fIsCompressed: Boolean;
1154 fRange: TglBitmapColorRec;
1157 fglFormat: Cardinal;
1158 fglInternalFormat: Cardinal;
1159 fglDataFormat: Cardinal;
1161 function GetComponents: Integer; virtual;
1163 property Format: TglBitmapFormat read fFormat;
1164 property WithAlpha: TglBitmapFormat read fWithAlpha;
1165 property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
1166 property RGBInverted: TglBitmapFormat read fRGBInverted;
1167 property Components: Integer read GetComponents;
1168 property PixelSize: Single read fPixelSize;
1169 property IsCompressed: Boolean read fIsCompressed;
1171 property glFormat: Cardinal read fglFormat;
1172 property glInternalFormat: Cardinal read fglInternalFormat;
1173 property glDataFormat: Cardinal read fglDataFormat;
1175 property Range: TglBitmapColorRec read fRange;
1176 property Shift: TShiftRec read fShift;
1178 property RedMask: QWord read GetRedMask;
1179 property GreenMask: QWord read GetGreenMask;
1180 property BlueMask: QWord read GetBlueMask;
1181 property AlphaMask: QWord read GetAlphaMask;
1183 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
1184 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
1186 function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
1187 function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
1189 function CreateMappingData: Pointer; virtual;
1190 procedure FreeMappingData(var aMappingData: Pointer); virtual;
1192 function IsEmpty: Boolean; virtual;
1193 function HasAlpha: Boolean; virtual;
1194 function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
1196 procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
1198 constructor Create; virtual;
1200 class procedure Init;
1201 class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
1202 class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
1203 class procedure Clear;
1204 class procedure Finalize;
1206 TFormatDescriptorClass = class of TFormatDescriptor;
1208 TfdEmpty = class(TFormatDescriptor);
1210 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1211 TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
1212 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1213 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1214 constructor Create; override;
1217 TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
1218 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1219 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1220 constructor Create; override;
1223 TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
1224 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1225 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1226 constructor Create; override;
1229 TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
1230 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1231 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1232 constructor Create; override;
1235 TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
1236 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1237 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1238 constructor Create; override;
1241 TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
1242 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1243 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1244 constructor Create; override;
1247 TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
1248 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1249 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1250 constructor Create; override;
1253 TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
1254 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1255 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1256 constructor Create; override;
1259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1260 TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
1261 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1262 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1263 constructor Create; override;
1266 TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
1267 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1268 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1269 constructor Create; override;
1272 TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
1273 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1274 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1275 constructor Create; override;
1278 TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
1279 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1280 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1281 constructor Create; override;
1284 TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
1285 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1286 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1287 constructor Create; override;
1290 TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
1291 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1292 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1293 constructor Create; override;
1296 TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
1297 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1298 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1299 constructor Create; override;
1302 TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
1303 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1304 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1305 constructor Create; override;
1308 TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
1309 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1310 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1311 constructor Create; override;
1314 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1315 TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
1316 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1317 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1318 constructor Create; override;
1321 TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
1322 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1323 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1324 constructor Create; override;
1327 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1328 TfdAlpha4 = class(TfdAlpha_UB1)
1329 constructor Create; override;
1332 TfdAlpha8 = class(TfdAlpha_UB1)
1333 constructor Create; override;
1336 TfdAlpha12 = class(TfdAlpha_US1)
1337 constructor Create; override;
1340 TfdAlpha16 = class(TfdAlpha_US1)
1341 constructor Create; override;
1344 TfdLuminance4 = class(TfdLuminance_UB1)
1345 constructor Create; override;
1348 TfdLuminance8 = class(TfdLuminance_UB1)
1349 constructor Create; override;
1352 TfdLuminance12 = class(TfdLuminance_US1)
1353 constructor Create; override;
1356 TfdLuminance16 = class(TfdLuminance_US1)
1357 constructor Create; override;
1360 TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
1361 constructor Create; override;
1364 TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
1365 constructor Create; override;
1368 TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
1369 constructor Create; override;
1372 TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
1373 constructor Create; override;
1376 TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
1377 constructor Create; override;
1380 TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
1381 constructor Create; override;
1384 TfdR3G3B2 = class(TfdUniversal_UB1)
1385 constructor Create; override;
1388 TfdRGB4 = class(TfdUniversal_US1)
1389 constructor Create; override;
1392 TfdR5G6B5 = class(TfdUniversal_US1)
1393 constructor Create; override;
1396 TfdRGB5 = class(TfdUniversal_US1)
1397 constructor Create; override;
1400 TfdRGB8 = class(TfdRGB_UB3)
1401 constructor Create; override;
1404 TfdRGB10 = class(TfdUniversal_UI1)
1405 constructor Create; override;
1408 TfdRGB12 = class(TfdRGB_US3)
1409 constructor Create; override;
1412 TfdRGB16 = class(TfdRGB_US3)
1413 constructor Create; override;
1416 TfdRGBA2 = class(TfdRGBA_UB4)
1417 constructor Create; override;
1420 TfdRGBA4 = class(TfdUniversal_US1)
1421 constructor Create; override;
1424 TfdRGB5A1 = class(TfdUniversal_US1)
1425 constructor Create; override;
1428 TfdRGBA8 = class(TfdRGBA_UB4)
1429 constructor Create; override;
1432 TfdRGB10A2 = class(TfdUniversal_UI1)
1433 constructor Create; override;
1436 TfdRGBA12 = class(TfdRGBA_US4)
1437 constructor Create; override;
1440 TfdRGBA16 = class(TfdRGBA_US4)
1441 constructor Create; override;
1444 TfdBGR4 = class(TfdUniversal_US1)
1445 constructor Create; override;
1448 TfdB5G6R5 = class(TfdUniversal_US1)
1449 constructor Create; override;
1452 TfdBGR5 = class(TfdUniversal_US1)
1453 constructor Create; override;
1456 TfdBGR8 = class(TfdBGR_UB3)
1457 constructor Create; override;
1460 TfdBGR10 = class(TfdUniversal_UI1)
1461 constructor Create; override;
1464 TfdBGR12 = class(TfdBGR_US3)
1465 constructor Create; override;
1468 TfdBGR16 = class(TfdBGR_US3)
1469 constructor Create; override;
1472 TfdBGRA2 = class(TfdBGRA_UB4)
1473 constructor Create; override;
1476 TfdBGRA4 = class(TfdUniversal_US1)
1477 constructor Create; override;
1480 TfdBGR5A1 = class(TfdUniversal_US1)
1481 constructor Create; override;
1484 TfdBGRA8 = class(TfdBGRA_UB4)
1485 constructor Create; override;
1488 TfdBGR10A2 = class(TfdUniversal_UI1)
1489 constructor Create; override;
1492 TfdBGRA12 = class(TfdBGRA_US4)
1493 constructor Create; override;
1496 TfdBGRA16 = class(TfdBGRA_US4)
1497 constructor Create; override;
1500 TfdDepth16 = class(TfdDepth_US1)
1501 constructor Create; override;
1504 TfdDepth24 = class(TfdDepth_UI1)
1505 constructor Create; override;
1508 TfdDepth32 = class(TfdDepth_UI1)
1509 constructor Create; override;
1512 TfdS3tcDtx1RGBA = class(TFormatDescriptor)
1513 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1514 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1515 constructor Create; override;
1518 TfdS3tcDtx3RGBA = class(TFormatDescriptor)
1519 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1520 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1521 constructor Create; override;
1524 TfdS3tcDtx5RGBA = class(TFormatDescriptor)
1525 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1526 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1527 constructor Create; override;
1530 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1531 TbmpBitfieldFormat = class(TFormatDescriptor)
1533 procedure SetRedMask (const aValue: QWord);
1534 procedure SetGreenMask(const aValue: QWord);
1535 procedure SetBlueMask (const aValue: QWord);
1536 procedure SetAlphaMask(const aValue: QWord);
1538 procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
1540 property RedMask: QWord read GetRedMask write SetRedMask;
1541 property GreenMask: QWord read GetGreenMask write SetGreenMask;
1542 property BlueMask: QWord read GetBlueMask write SetBlueMask;
1543 property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
1545 property PixelSize: Single read fPixelSize write fPixelSize;
1547 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1548 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1551 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1552 TbmpColorTableEnty = packed record
1555 TbmpColorTable = array of TbmpColorTableEnty;
1556 TbmpColorTableFormat = class(TFormatDescriptor)
1558 fColorTable: TbmpColorTable;
1560 property PixelSize: Single read fPixelSize write fPixelSize;
1561 property ColorTable: TbmpColorTable read fColorTable write fColorTable;
1562 property Range: TglBitmapColorRec read fRange write fRange;
1563 property Shift: TShiftRec read fShift write fShift;
1564 property Format: TglBitmapFormat read fFormat write fFormat;
1566 procedure CreateColorTable;
1568 procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
1569 procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
1570 destructor Destroy; override;
1574 LUMINANCE_WEIGHT_R = 0.30;
1575 LUMINANCE_WEIGHT_G = 0.59;
1576 LUMINANCE_WEIGHT_B = 0.11;
1578 ALPHA_WEIGHT_R = 0.30;
1579 ALPHA_WEIGHT_G = 0.59;
1580 ALPHA_WEIGHT_B = 0.11;
1582 DEPTH_WEIGHT_R = 0.333333333;
1583 DEPTH_WEIGHT_G = 0.333333333;
1584 DEPTH_WEIGHT_B = 0.333333333;
1586 UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
1588 FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
1601 TfdLuminance4Alpha4,
1602 TfdLuminance6Alpha2,
1603 TfdLuminance8Alpha8,
1604 TfdLuminance12Alpha4,
1605 TfdLuminance12Alpha12,
1606 TfdLuminance16Alpha16,
1651 FormatDescriptorCS: TCriticalSection;
1652 FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
1654 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1655 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1657 result.Fields := [];
1660 result.Fields := result.Fields + [ffX];
1662 result.Fields := result.Fields + [ffY];
1664 result.X := Max(0, X);
1665 result.Y := Max(0, Y);
1668 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1669 function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
1677 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1678 function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
1683 for i := 0 to high(r1.arr) do
1684 if (r1.arr[i] <> r2.arr[i]) then
1689 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1690 function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
1698 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1699 function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
1708 tfR3G3B2, tfLuminance8,
1711 tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
1712 tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
1718 tfRGB10, tfRGB10A2, tfRGBA8,
1719 tfBGR10, tfBGR10A2, tfBGRA8]) then
1720 result := result + [ftBMP];
1724 tfLuminance8, tfAlpha8,
1727 tfLuminance16, tfLuminance8Alpha8,
1728 tfRGB5, tfRGB5A1, tfRGBA4,
1729 tfBGR5, tfBGR5A1, tfBGRA4,
1735 tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
1736 result := result + [ftTGA];
1740 tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
1741 tfR3G3B2, tfRGBA2, tfBGRA2,
1744 tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
1745 tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
1746 tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
1752 tfLuminance16Alpha16,
1757 tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
1758 result := result + [ftDDS];
1761 {$IFDEF GLB_SUPPORT_PNG_WRITE}
1763 tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1764 tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1765 tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
1766 tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1767 tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
1768 tfDepth16, tfDepth24, tfDepth32]
1770 result := result + [ftPNG];
1773 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
1775 tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1776 tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1777 tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1778 tfDepth16, tfDepth24, tfDepth32]
1780 result := result + [ftJPEG];
1784 tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
1785 tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
1786 tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
1787 tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
1788 tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
1789 tfDepth16, tfDepth24, tfDepth32]
1791 result := result + [ftDDS, ftTGA, ftBMP];
1795 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1796 function IsPowerOfTwo(aNumber: Integer): Boolean;
1798 while (aNumber and 1) = 0 do
1799 aNumber := aNumber shr 1;
1800 result := aNumber = 1;
1803 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1804 function GetTopMostBit(aBitSet: QWord): Integer;
1807 while aBitSet > 0 do begin
1809 aBitSet := aBitSet shr 1;
1813 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1814 function CountSetBits(aBitSet: QWord): Integer;
1817 while aBitSet > 0 do begin
1818 if (aBitSet and 1) = 1 then
1820 aBitSet := aBitSet shr 1;
1824 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1825 function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
1828 LUMINANCE_WEIGHT_R * aPixel.Data.r +
1829 LUMINANCE_WEIGHT_G * aPixel.Data.g +
1830 LUMINANCE_WEIGHT_B * aPixel.Data.b);
1833 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1834 function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
1837 DEPTH_WEIGHT_R * aPixel.Data.r +
1838 DEPTH_WEIGHT_G * aPixel.Data.g +
1839 DEPTH_WEIGHT_B * aPixel.Data.b);
1842 {$IFDEF GLB_NATIVE_OGL}
1843 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1844 //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1845 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1847 GL_LibHandle: Pointer = nil;
1849 function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
1853 if not Assigned(aLibHandle) then
1854 aLibHandle := GL_LibHandle;
1856 {$IF DEFINED(GLB_WIN)}
1857 result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
1858 if Assigned(result) then
1861 if Assigned(wglGetProcAddress) then
1862 result := wglGetProcAddress(aProcName);
1863 {$ELSEIF DEFINED(GLB_LINUX)}
1864 if Assigned(glXGetProcAddress) then begin
1865 result := glXGetProcAddress(aProcName);
1866 if Assigned(result) then
1870 if Assigned(glXGetProcAddressARB) then begin
1871 result := glXGetProcAddressARB(aProcName);
1872 if Assigned(result) then
1876 result := dlsym(aLibHandle, aProcName);
1878 if not Assigned(result) then
1879 raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
1882 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
1884 GLU_LibHandle: Pointer = nil;
1885 OpenGLInitialized: Boolean;
1886 InitOpenGLCS: TCriticalSection;
1888 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1889 procedure glbInitOpenGL;
1891 ////////////////////////////////////////////////////////////////////////////////
1892 function glbLoadLibrary(const aName: PChar): Pointer;
1894 {$IF DEFINED(GLB_WIN)}
1895 result := {%H-}Pointer(LoadLibrary(aName));
1896 {$ELSEIF DEFINED(GLB_LINUX)}
1897 result := dlopen(Name, RTLD_LAZY);
1903 ////////////////////////////////////////////////////////////////////////////////
1904 function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
1907 if not Assigned(aLibHandle) then
1910 {$IF DEFINED(GLB_WIN)}
1911 Result := FreeLibrary({%H-}HINST(aLibHandle));
1912 {$ELSEIF DEFINED(GLB_LINUX)}
1913 Result := dlclose(aLibHandle) = 0;
1918 if Assigned(GL_LibHandle) then
1919 glbFreeLibrary(GL_LibHandle);
1921 if Assigned(GLU_LibHandle) then
1922 glbFreeLibrary(GLU_LibHandle);
1924 GL_LibHandle := glbLoadLibrary(libopengl);
1925 if not Assigned(GL_LibHandle) then
1926 raise EglBitmapException.Create('unable to load library: ' + libopengl);
1928 GLU_LibHandle := glbLoadLibrary(libglu);
1929 if not Assigned(GLU_LibHandle) then
1930 raise EglBitmapException.Create('unable to load library: ' + libglu);
1933 {$IF DEFINED(GLB_WIN)}
1934 wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
1935 {$ELSEIF DEFINED(GLB_LINUX)}
1936 glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
1937 glXGetProcAddressARB := dglGetProcAddress('glXGetProcAddressARB');
1940 glEnable := glbGetProcAddress('glEnable');
1941 glDisable := glbGetProcAddress('glDisable');
1942 glGetString := glbGetProcAddress('glGetString');
1943 glGetIntegerv := glbGetProcAddress('glGetIntegerv');
1944 glTexParameteri := glbGetProcAddress('glTexParameteri');
1945 glTexParameterfv := glbGetProcAddress('glTexParameterfv');
1946 glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
1947 glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
1948 glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
1949 glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
1950 glGenTextures := glbGetProcAddress('glGenTextures');
1951 glBindTexture := glbGetProcAddress('glBindTexture');
1952 glDeleteTextures := glbGetProcAddress('glDeleteTextures');
1953 glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
1954 glReadPixels := glbGetProcAddress('glReadPixels');
1955 glPixelStorei := glbGetProcAddress('glPixelStorei');
1956 glTexImage1D := glbGetProcAddress('glTexImage1D');
1957 glTexImage2D := glbGetProcAddress('glTexImage2D');
1958 glGetTexImage := glbGetProcAddress('glGetTexImage');
1960 gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
1961 gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
1963 glbFreeLibrary(GL_LibHandle);
1964 glbFreeLibrary(GLU_LibHandle);
1969 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
1970 procedure glbReadOpenGLExtensions;
1976 MajorVersion, MinorVersion: Integer;
1978 ///////////////////////////////////////////////////////////////////////////////////////////
1979 procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
1986 Separator := Pos(AnsiString('.'), aBuffer);
1987 if (Separator > 1) and (Separator < Length(aBuffer)) and
1988 (aBuffer[Separator - 1] in ['0'..'9']) and
1989 (aBuffer[Separator + 1] in ['0'..'9']) then begin
1992 while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
1995 Delete(aBuffer, 1, Separator);
1996 Separator := Pos(AnsiString('.'), aBuffer) + 1;
1998 while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
2001 Delete(aBuffer, Separator, 255);
2002 Separator := Pos(AnsiString('.'), aBuffer);
2004 aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
2005 aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
2009 ///////////////////////////////////////////////////////////////////////////////////////////
2010 function CheckExtension(const Extension: AnsiString): Boolean;
2014 ExtPos := Pos(Extension, Buffer);
2015 result := ExtPos > 0;
2017 result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
2021 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
2024 if not OpenGLInitialized then begin
2026 OpenGLInitialized := true;
2034 Context := wglGetCurrentContext;
2035 if (Context <> gLastContext) then begin
2036 gLastContext := Context;
2040 Buffer := glGetString(GL_VERSION);
2041 TrimVersionString(Buffer, MajorVersion, MinorVersion);
2043 GL_VERSION_1_2 := false;
2044 GL_VERSION_1_3 := false;
2045 GL_VERSION_1_4 := false;
2046 GL_VERSION_2_0 := false;
2047 if MajorVersion = 1 then begin
2048 if MinorVersion >= 2 then
2049 GL_VERSION_1_2 := true;
2051 if MinorVersion >= 3 then
2052 GL_VERSION_1_3 := true;
2054 if MinorVersion >= 4 then
2055 GL_VERSION_1_4 := true;
2056 end else if MajorVersion >= 2 then begin
2057 GL_VERSION_1_2 := true;
2058 GL_VERSION_1_3 := true;
2059 GL_VERSION_1_4 := true;
2060 GL_VERSION_2_0 := true;
2064 Buffer := glGetString(GL_EXTENSIONS);
2065 GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
2066 GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
2067 GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
2068 GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
2069 GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
2070 GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
2071 GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
2072 GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
2073 GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
2074 GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
2076 if GL_VERSION_1_3 then begin
2077 glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
2078 glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
2079 glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
2081 glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB');
2082 glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB');
2083 glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
2093 function CreateGrayPalette: HPALETTE;
2098 GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
2100 Pal.palVersion := $300;
2101 Pal.palNumEntries := 256;
2104 {$DEFINE GLB_TEMPRANGECHECK}
2108 for Idx := 0 to 256 - 1 do begin
2109 Pal.palPalEntry[Idx].peRed := Idx;
2110 Pal.palPalEntry[Idx].peGreen := Idx;
2111 Pal.palPalEntry[Idx].peBlue := Idx;
2112 Pal.palPalEntry[Idx].peFlags := 0;
2115 {$IFDEF GLB_TEMPRANGECHECK}
2116 {$UNDEF GLB_TEMPRANGECHECK}
2120 result := CreatePalette(Pal^);
2127 {$IFDEF GLB_SDL_IMAGE}
2128 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2129 // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2130 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2131 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
2133 result := TStream(context^.unknown.data1).Seek(offset, whence);
2136 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
2138 result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
2141 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
2143 result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
2146 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
2151 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
2153 result := SDL_AllocRW;
2155 if result = nil then
2156 raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
2158 result^.seek := glBitmapRWseek;
2159 result^.read := glBitmapRWread;
2160 result^.write := glBitmapRWwrite;
2161 result^.close := glBitmapRWclose;
2162 result^.unknown.data1 := Stream;
2167 function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
2169 glBitmap: TglBitmap2D;
2175 if Instance = 0 then
2176 Instance := HInstance;
2178 if (LoadFromRes) then
2179 glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
2182 glBitmap := TglBitmap2D.Create(FileName);
2185 glBitmap.DeleteTextureOnFree := false;
2186 glBitmap.FreeDataAfterGenTexture := false;
2187 glBitmap.GenTexture(true);
2188 if (glBitmap.ID > 0) then begin
2189 Texture := glBitmap.ID;
2197 function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
2199 CM: TglBitmapCubeMap;
2204 if Instance = 0 then
2205 Instance := HInstance;
2208 CM := TglBitmapCubeMap.Create;
2210 CM.DeleteTextureOnFree := false;
2214 if (LoadFromRes) then
2215 CM.LoadFromResource(Instance, PositiveX)
2218 CM.LoadFromFile(PositiveX);
2219 CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
2222 if (LoadFromRes) then
2223 CM.LoadFromResource(Instance, NegativeX)
2226 CM.LoadFromFile(NegativeX);
2227 CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
2230 if (LoadFromRes) then
2231 CM.LoadFromResource(Instance, PositiveY)
2234 CM.LoadFromFile(PositiveY);
2235 CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
2238 if (LoadFromRes) then
2239 CM.LoadFromResource(Instance, NegativeY)
2242 CM.LoadFromFile(NegativeY);
2243 CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
2246 if (LoadFromRes) then
2247 CM.LoadFromResource(Instance, PositiveZ)
2250 CM.LoadFromFile(PositiveZ);
2251 CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
2254 if (LoadFromRes) then
2255 CM.LoadFromResource(Instance, NegativeZ)
2258 CM.LoadFromFile(NegativeZ);
2259 CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
2268 function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
2270 NM: TglBitmapNormalMap;
2274 NM := TglBitmapNormalMap.Create;
2276 NM.DeleteTextureOnFree := false;
2277 NM.GenerateNormalMap(Size);
2287 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2288 procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
2290 glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
2293 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2294 procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
2296 glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
2299 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2300 procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
2302 glBitmapDefaultMipmap := aValue;
2305 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2306 procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
2308 glBitmapDefaultFormat := aFormat;
2311 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2312 procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
2314 glBitmapDefaultFilterMin := aMin;
2315 glBitmapDefaultFilterMag := aMag;
2318 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2319 procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
2321 glBitmapDefaultWrapS := S;
2322 glBitmapDefaultWrapT := T;
2323 glBitmapDefaultWrapR := R;
2326 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2327 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2329 result := glBitmapDefaultDeleteTextureOnFree;
2332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2333 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2335 result := glBitmapDefaultFreeDataAfterGenTextures;
2338 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2339 function glBitmapGetDefaultMipmap: TglBitmapMipMap;
2341 result := glBitmapDefaultMipmap;
2344 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2345 function glBitmapGetDefaultFormat: TglBitmapFormat;
2347 result := glBitmapDefaultFormat;
2350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2351 procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
2353 aMin := glBitmapDefaultFilterMin;
2354 aMag := glBitmapDefaultFilterMag;
2357 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2358 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
2360 S := glBitmapDefaultWrapS;
2361 T := glBitmapDefaultWrapT;
2362 R := glBitmapDefaultWrapR;
2365 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2366 //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2367 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2368 function TFormatDescriptor.GetRedMask: QWord;
2370 result := fRange.r shl fShift.r;
2373 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2374 function TFormatDescriptor.GetGreenMask: QWord;
2376 result := fRange.g shl fShift.g;
2379 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2380 function TFormatDescriptor.GetBlueMask: QWord;
2382 result := fRange.b shl fShift.b;
2385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2386 function TFormatDescriptor.GetAlphaMask: QWord;
2388 result := fRange.a shl fShift.a;
2391 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2392 function TFormatDescriptor.GetComponents: Integer;
2398 if (fRange.arr[i] > 0) then
2402 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2403 function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
2407 if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
2408 w := Max(1, aSize.X);
2409 h := Max(1, aSize.Y);
2410 result := GetSize(w, h);
2415 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2416 function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
2419 if (aWidth <= 0) or (aHeight <= 0) then
2421 result := Ceil(aWidth * aHeight * fPixelSize);
2424 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2425 function TFormatDescriptor.CreateMappingData: Pointer;
2430 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2431 procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
2436 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2437 function TFormatDescriptor.IsEmpty: Boolean;
2439 result := (fFormat = tfEmpty);
2442 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2443 function TFormatDescriptor.HasAlpha: Boolean;
2445 result := (fRange.a > 0);
2448 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2449 function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
2453 if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
2454 raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
2456 if (aRedMask <> RedMask) then
2458 if (aGreenMask <> GreenMask) then
2460 if (aBlueMask <> BlueMask) then
2462 if (aAlphaMask <> AlphaMask) then
2467 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2468 procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
2470 FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
2471 aPixel.Data := fRange;
2472 aPixel.Range := fRange;
2473 aPixel.Format := fFormat;
2476 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2477 constructor TFormatDescriptor.Create;
2482 fWithAlpha := tfEmpty;
2483 fWithoutAlpha := tfEmpty;
2484 fRGBInverted := tfEmpty;
2485 fUncompressed := tfEmpty;
2487 fIsCompressed := false;
2490 fglInternalFormat := 0;
2493 FillChar(fRange, 0, SizeOf(fRange));
2494 FillChar(fShift, 0, SizeOf(fShift));
2497 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2498 //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2499 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2500 procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2502 aData^ := aPixel.Data.a;
2506 procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2511 aPixel.Data.a := aData^;
2515 constructor TfdAlpha_UB1.Create;
2520 fglFormat := GL_ALPHA;
2521 fglDataFormat := GL_UNSIGNED_BYTE;
2524 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2525 //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2526 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2527 procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2529 aData^ := LuminanceWeight(aPixel);
2533 procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2535 aPixel.Data.r := aData^;
2536 aPixel.Data.g := aData^;
2537 aPixel.Data.b := aData^;
2542 constructor TfdLuminance_UB1.Create;
2549 fglFormat := GL_LUMINANCE;
2550 fglDataFormat := GL_UNSIGNED_BYTE;
2553 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2554 //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2555 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2556 procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2562 if (fRange.arr[i] > 0) then
2563 aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2567 procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2572 aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
2576 constructor TfdUniversal_UB1.Create;
2582 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2583 //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2584 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2585 procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2587 inherited Map(aPixel, aData, aMapData);
2588 aData^ := aPixel.Data.a;
2592 procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2594 inherited Unmap(aData, aPixel, aMapData);
2595 aPixel.Data.a := aData^;
2599 constructor TfdLuminanceAlpha_UB2.Create;
2605 fglFormat := GL_LUMINANCE_ALPHA;
2606 fglDataFormat := GL_UNSIGNED_BYTE;
2609 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2610 //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2611 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2612 procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2614 aData^ := aPixel.Data.r;
2616 aData^ := aPixel.Data.g;
2618 aData^ := aPixel.Data.b;
2622 procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2624 aPixel.Data.r := aData^;
2626 aPixel.Data.g := aData^;
2628 aPixel.Data.b := aData^;
2633 constructor TfdRGB_UB3.Create;
2643 fglFormat := GL_RGB;
2644 fglDataFormat := GL_UNSIGNED_BYTE;
2647 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2648 //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2649 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2650 procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2652 aData^ := aPixel.Data.b;
2654 aData^ := aPixel.Data.g;
2656 aData^ := aPixel.Data.r;
2660 procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2662 aPixel.Data.b := aData^;
2664 aPixel.Data.g := aData^;
2666 aPixel.Data.r := aData^;
2671 constructor TfdBGR_UB3.Create;
2680 fglFormat := GL_BGR;
2681 fglDataFormat := GL_UNSIGNED_BYTE;
2684 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2685 //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2686 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2687 procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2689 inherited Map(aPixel, aData, aMapData);
2690 aData^ := aPixel.Data.a;
2694 procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2696 inherited Unmap(aData, aPixel, aMapData);
2697 aPixel.Data.a := aData^;
2701 constructor TfdRGBA_UB4.Create;
2707 fglFormat := GL_RGBA;
2708 fglDataFormat := GL_UNSIGNED_BYTE;
2711 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2712 //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2713 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2714 procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2716 inherited Map(aPixel, aData, aMapData);
2717 aData^ := aPixel.Data.a;
2721 procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2723 inherited Unmap(aData, aPixel, aMapData);
2724 aPixel.Data.a := aData^;
2728 constructor TfdBGRA_UB4.Create;
2734 fglFormat := GL_BGRA;
2735 fglDataFormat := GL_UNSIGNED_BYTE;
2738 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2739 //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2741 procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2743 PWord(aData)^ := aPixel.Data.a;
2747 procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2752 aPixel.Data.a := PWord(aData)^;
2756 constructor TfdAlpha_US1.Create;
2761 fglFormat := GL_ALPHA;
2762 fglDataFormat := GL_UNSIGNED_SHORT;
2765 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2766 //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2767 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2768 procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2770 PWord(aData)^ := LuminanceWeight(aPixel);
2774 procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2776 aPixel.Data.r := PWord(aData)^;
2777 aPixel.Data.g := PWord(aData)^;
2778 aPixel.Data.b := PWord(aData)^;
2783 constructor TfdLuminance_US1.Create;
2790 fglFormat := GL_LUMINANCE;
2791 fglDataFormat := GL_UNSIGNED_SHORT;
2794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2795 //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2796 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2797 procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2803 if (fRange.arr[i] > 0) then
2804 PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
2808 procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2813 aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
2817 constructor TfdUniversal_US1.Create;
2823 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2824 //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2825 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2826 procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2828 PWord(aData)^ := DepthWeight(aPixel);
2832 procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2834 aPixel.Data.r := PWord(aData)^;
2835 aPixel.Data.g := PWord(aData)^;
2836 aPixel.Data.b := PWord(aData)^;
2841 constructor TfdDepth_US1.Create;
2848 fglFormat := GL_DEPTH_COMPONENT;
2849 fglDataFormat := GL_UNSIGNED_SHORT;
2852 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2853 //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2854 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2855 procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2857 inherited Map(aPixel, aData, aMapData);
2858 PWord(aData)^ := aPixel.Data.a;
2862 procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2864 inherited Unmap(aData, aPixel, aMapData);
2865 aPixel.Data.a := PWord(aData)^;
2869 constructor TfdLuminanceAlpha_US2.Create;
2875 fglFormat := GL_LUMINANCE_ALPHA;
2876 fglDataFormat := GL_UNSIGNED_SHORT;
2879 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2880 //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2881 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2882 procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2884 PWord(aData)^ := aPixel.Data.r;
2886 PWord(aData)^ := aPixel.Data.g;
2888 PWord(aData)^ := aPixel.Data.b;
2892 procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2894 aPixel.Data.r := PWord(aData)^;
2896 aPixel.Data.g := PWord(aData)^;
2898 aPixel.Data.b := PWord(aData)^;
2903 constructor TfdRGB_US3.Create;
2913 fglFormat := GL_RGB;
2914 fglDataFormat := GL_UNSIGNED_SHORT;
2917 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2918 //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2919 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2920 procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2922 PWord(aData)^ := aPixel.Data.b;
2924 PWord(aData)^ := aPixel.Data.g;
2926 PWord(aData)^ := aPixel.Data.r;
2930 procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2932 aPixel.Data.b := PWord(aData)^;
2934 aPixel.Data.g := PWord(aData)^;
2936 aPixel.Data.r := PWord(aData)^;
2941 constructor TfdBGR_US3.Create;
2951 fglFormat := GL_BGR;
2952 fglDataFormat := GL_UNSIGNED_SHORT;
2955 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2956 //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2957 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2958 procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2960 inherited Map(aPixel, aData, aMapData);
2961 PWord(aData)^ := aPixel.Data.a;
2965 procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2967 inherited Unmap(aData, aPixel, aMapData);
2968 aPixel.Data.a := PWord(aData)^;
2972 constructor TfdRGBA_US4.Create;
2978 fglFormat := GL_RGBA;
2979 fglDataFormat := GL_UNSIGNED_SHORT;
2982 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2983 //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2984 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
2985 procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
2987 inherited Map(aPixel, aData, aMapData);
2988 PWord(aData)^ := aPixel.Data.a;
2992 procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
2994 inherited Unmap(aData, aPixel, aMapData);
2995 aPixel.Data.a := PWord(aData)^;
2999 constructor TfdBGRA_US4.Create;
3005 fglFormat := GL_BGRA;
3006 fglDataFormat := GL_UNSIGNED_SHORT;
3009 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3010 //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3011 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3012 procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3016 PCardinal(aData)^ := 0;
3018 if (fRange.arr[i] > 0) then
3019 PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
3023 procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3028 aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
3032 constructor TfdUniversal_UI1.Create;
3038 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3039 //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3040 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3041 procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3043 PCardinal(aData)^ := DepthWeight(aPixel);
3047 procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3049 aPixel.Data.r := PCardinal(aData)^;
3050 aPixel.Data.g := PCardinal(aData)^;
3051 aPixel.Data.b := PCardinal(aData)^;
3056 constructor TfdDepth_UI1.Create;
3060 fRange.r := $FFFFFFFF;
3061 fRange.g := $FFFFFFFF;
3062 fRange.b := $FFFFFFFF;
3063 fglFormat := GL_DEPTH_COMPONENT;
3064 fglDataFormat := GL_UNSIGNED_INT;
3067 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3068 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3069 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3070 constructor TfdAlpha4.Create;
3073 fFormat := tfAlpha4;
3074 fWithAlpha := tfAlpha4;
3075 fglInternalFormat := GL_ALPHA4;
3078 constructor TfdAlpha8.Create;
3081 fFormat := tfAlpha8;
3082 fWithAlpha := tfAlpha8;
3083 fglInternalFormat := GL_ALPHA8;
3086 constructor TfdAlpha12.Create;
3089 fFormat := tfAlpha12;
3090 fWithAlpha := tfAlpha12;
3091 fglInternalFormat := GL_ALPHA12;
3094 constructor TfdAlpha16.Create;
3097 fFormat := tfAlpha16;
3098 fWithAlpha := tfAlpha16;
3099 fglInternalFormat := GL_ALPHA16;
3102 constructor TfdLuminance4.Create;
3105 fFormat := tfLuminance4;
3106 fWithAlpha := tfLuminance4Alpha4;
3107 fWithoutAlpha := tfLuminance4;
3108 fglInternalFormat := GL_LUMINANCE4;
3111 constructor TfdLuminance8.Create;
3114 fFormat := tfLuminance8;
3115 fWithAlpha := tfLuminance8Alpha8;
3116 fWithoutAlpha := tfLuminance8;
3117 fglInternalFormat := GL_LUMINANCE8;
3120 constructor TfdLuminance12.Create;
3123 fFormat := tfLuminance12;
3124 fWithAlpha := tfLuminance12Alpha12;
3125 fWithoutAlpha := tfLuminance12;
3126 fglInternalFormat := GL_LUMINANCE12;
3129 constructor TfdLuminance16.Create;
3132 fFormat := tfLuminance16;
3133 fWithAlpha := tfLuminance16Alpha16;
3134 fWithoutAlpha := tfLuminance16;
3135 fglInternalFormat := GL_LUMINANCE16;
3138 constructor TfdLuminance4Alpha4.Create;
3141 fFormat := tfLuminance4Alpha4;
3142 fWithAlpha := tfLuminance4Alpha4;
3143 fWithoutAlpha := tfLuminance4;
3144 fglInternalFormat := GL_LUMINANCE4_ALPHA4;
3147 constructor TfdLuminance6Alpha2.Create;
3150 fFormat := tfLuminance6Alpha2;
3151 fWithAlpha := tfLuminance6Alpha2;
3152 fWithoutAlpha := tfLuminance8;
3153 fglInternalFormat := GL_LUMINANCE6_ALPHA2;
3156 constructor TfdLuminance8Alpha8.Create;
3159 fFormat := tfLuminance8Alpha8;
3160 fWithAlpha := tfLuminance8Alpha8;
3161 fWithoutAlpha := tfLuminance8;
3162 fglInternalFormat := GL_LUMINANCE8_ALPHA8;
3165 constructor TfdLuminance12Alpha4.Create;
3168 fFormat := tfLuminance12Alpha4;
3169 fWithAlpha := tfLuminance12Alpha4;
3170 fWithoutAlpha := tfLuminance12;
3171 fglInternalFormat := GL_LUMINANCE12_ALPHA4;
3174 constructor TfdLuminance12Alpha12.Create;
3177 fFormat := tfLuminance12Alpha12;
3178 fWithAlpha := tfLuminance12Alpha12;
3179 fWithoutAlpha := tfLuminance12;
3180 fglInternalFormat := GL_LUMINANCE12_ALPHA12;
3183 constructor TfdLuminance16Alpha16.Create;
3186 fFormat := tfLuminance16Alpha16;
3187 fWithAlpha := tfLuminance16Alpha16;
3188 fWithoutAlpha := tfLuminance16;
3189 fglInternalFormat := GL_LUMINANCE16_ALPHA16;
3192 constructor TfdR3G3B2.Create;
3195 fFormat := tfR3G3B2;
3196 fWithAlpha := tfRGBA2;
3197 fWithoutAlpha := tfR3G3B2;
3204 fglFormat := GL_RGB;
3205 fglInternalFormat := GL_R3_G3_B2;
3206 fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
3209 constructor TfdRGB4.Create;
3213 fWithAlpha := tfRGBA4;
3214 fWithoutAlpha := tfRGB4;
3215 fRGBInverted := tfBGR4;
3222 fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3223 fglInternalFormat := GL_RGB4;
3224 fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3227 constructor TfdR5G6B5.Create;
3230 fFormat := tfR5G6B5;
3231 fWithAlpha := tfRGBA4;
3232 fWithoutAlpha := tfR5G6B5;
3233 fRGBInverted := tfB5G6R5;
3240 fglFormat := GL_RGB;
3241 fglInternalFormat := GL_RGB565;
3242 fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
3245 constructor TfdRGB5.Create;
3249 fWithAlpha := tfRGB5A1;
3250 fWithoutAlpha := tfRGB5;
3251 fRGBInverted := tfBGR5;
3258 fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3259 fglInternalFormat := GL_RGB5;
3260 fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3263 constructor TfdRGB8.Create;
3267 fWithAlpha := tfRGBA8;
3268 fWithoutAlpha := tfRGB8;
3269 fRGBInverted := tfBGR8;
3270 fglInternalFormat := GL_RGB8;
3273 constructor TfdRGB10.Create;
3277 fWithAlpha := tfRGB10A2;
3278 fWithoutAlpha := tfRGB10;
3279 fRGBInverted := tfBGR10;
3286 fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3287 fglInternalFormat := GL_RGB10;
3288 fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
3291 constructor TfdRGB12.Create;
3295 fWithAlpha := tfRGBA12;
3296 fWithoutAlpha := tfRGB12;
3297 fRGBInverted := tfBGR12;
3298 fglInternalFormat := GL_RGB12;
3301 constructor TfdRGB16.Create;
3305 fWithAlpha := tfRGBA16;
3306 fWithoutAlpha := tfRGB16;
3307 fRGBInverted := tfBGR16;
3308 fglInternalFormat := GL_RGB16;
3311 constructor TfdRGBA2.Create;
3315 fWithAlpha := tfRGBA2;
3316 fWithoutAlpha := tfR3G3B2;
3317 fRGBInverted := tfBGRA2;
3318 fglInternalFormat := GL_RGBA2;
3321 constructor TfdRGBA4.Create;
3325 fWithAlpha := tfRGBA4;
3326 fWithoutAlpha := tfRGB4;
3327 fRGBInverted := tfBGRA4;
3336 fglFormat := GL_RGBA;
3337 fglInternalFormat := GL_RGBA4;
3338 fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3341 constructor TfdRGB5A1.Create;
3344 fFormat := tfRGB5A1;
3345 fWithAlpha := tfRGB5A1;
3346 fWithoutAlpha := tfRGB5;
3347 fRGBInverted := tfBGR5A1;
3356 fglFormat := GL_RGBA;
3357 fglInternalFormat := GL_RGB5_A1;
3358 fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3361 constructor TfdRGBA8.Create;
3365 fWithAlpha := tfRGBA8;
3366 fWithoutAlpha := tfRGB8;
3367 fRGBInverted := tfBGRA8;
3368 fglInternalFormat := GL_RGBA8;
3371 constructor TfdRGB10A2.Create;
3374 fFormat := tfRGB10A2;
3375 fWithAlpha := tfRGB10A2;
3376 fWithoutAlpha := tfRGB10;
3377 fRGBInverted := tfBGR10A2;
3386 fglFormat := GL_RGBA;
3387 fglInternalFormat := GL_RGB10_A2;
3388 fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
3391 constructor TfdRGBA12.Create;
3394 fFormat := tfRGBA12;
3395 fWithAlpha := tfRGBA12;
3396 fWithoutAlpha := tfRGB12;
3397 fRGBInverted := tfBGRA12;
3398 fglInternalFormat := GL_RGBA12;
3401 constructor TfdRGBA16.Create;
3404 fFormat := tfRGBA16;
3405 fWithAlpha := tfRGBA16;
3406 fWithoutAlpha := tfRGB16;
3407 fRGBInverted := tfBGRA16;
3408 fglInternalFormat := GL_RGBA16;
3411 constructor TfdBGR4.Create;
3416 fWithAlpha := tfBGRA4;
3417 fWithoutAlpha := tfBGR4;
3418 fRGBInverted := tfRGB4;
3427 fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3428 fglInternalFormat := GL_RGB4;
3429 fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3432 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3433 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3434 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3435 constructor TfdB5G6R5.Create;
3438 fFormat := tfB5G6R5;
3439 fWithAlpha := tfBGRA4;
3440 fWithoutAlpha := tfB5G6R5;
3441 fRGBInverted := tfR5G6B5;
3448 fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
3449 fglInternalFormat := GL_RGB8;
3450 fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
3453 constructor TfdBGR5.Create;
3458 fWithAlpha := tfBGR5A1;
3459 fWithoutAlpha := tfBGR5;
3460 fRGBInverted := tfRGB5;
3469 fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3470 fglInternalFormat := GL_RGB5;
3471 fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3474 constructor TfdBGR8.Create;
3478 fWithAlpha := tfBGRA8;
3479 fWithoutAlpha := tfBGR8;
3480 fRGBInverted := tfRGB8;
3481 fglInternalFormat := GL_RGB8;
3484 constructor TfdBGR10.Create;
3488 fWithAlpha := tfBGR10A2;
3489 fWithoutAlpha := tfBGR10;
3490 fRGBInverted := tfRGB10;
3499 fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
3500 fglInternalFormat := GL_RGB10;
3501 fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
3504 constructor TfdBGR12.Create;
3508 fWithAlpha := tfBGRA12;
3509 fWithoutAlpha := tfBGR12;
3510 fRGBInverted := tfRGB12;
3511 fglInternalFormat := GL_RGB12;
3514 constructor TfdBGR16.Create;
3518 fWithAlpha := tfBGRA16;
3519 fWithoutAlpha := tfBGR16;
3520 fRGBInverted := tfRGB16;
3521 fglInternalFormat := GL_RGB16;
3524 constructor TfdBGRA2.Create;
3528 fWithAlpha := tfBGRA4;
3529 fWithoutAlpha := tfBGR4;
3530 fRGBInverted := tfRGBA2;
3531 fglInternalFormat := GL_RGBA2;
3534 constructor TfdBGRA4.Create;
3538 fWithAlpha := tfBGRA4;
3539 fWithoutAlpha := tfBGR4;
3540 fRGBInverted := tfRGBA4;
3549 fglFormat := GL_BGRA;
3550 fglInternalFormat := GL_RGBA4;
3551 fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
3554 constructor TfdBGR5A1.Create;
3557 fFormat := tfBGR5A1;
3558 fWithAlpha := tfBGR5A1;
3559 fWithoutAlpha := tfBGR5;
3560 fRGBInverted := tfRGB5A1;
3569 fglFormat := GL_BGRA;
3570 fglInternalFormat := GL_RGB5_A1;
3571 fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
3574 constructor TfdBGRA8.Create;
3578 fWithAlpha := tfBGRA8;
3579 fWithoutAlpha := tfBGR8;
3580 fRGBInverted := tfRGBA8;
3581 fglInternalFormat := GL_RGBA8;
3584 constructor TfdBGR10A2.Create;
3587 fFormat := tfBGR10A2;
3588 fWithAlpha := tfBGR10A2;
3589 fWithoutAlpha := tfBGR10;
3590 fRGBInverted := tfRGB10A2;
3599 fglFormat := GL_BGRA;
3600 fglInternalFormat := GL_RGB10_A2;
3601 fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
3604 constructor TfdBGRA12.Create;
3607 fFormat := tfBGRA12;
3608 fWithAlpha := tfBGRA12;
3609 fWithoutAlpha := tfBGR12;
3610 fRGBInverted := tfRGBA12;
3611 fglInternalFormat := GL_RGBA12;
3614 constructor TfdBGRA16.Create;
3617 fFormat := tfBGRA16;
3618 fWithAlpha := tfBGRA16;
3619 fWithoutAlpha := tfBGR16;
3620 fRGBInverted := tfRGBA16;
3621 fglInternalFormat := GL_RGBA16;
3624 constructor TfdDepth16.Create;
3627 fFormat := tfDepth16;
3628 fWithAlpha := tfEmpty;
3629 fWithoutAlpha := tfDepth16;
3630 fglInternalFormat := GL_DEPTH_COMPONENT16;
3633 constructor TfdDepth24.Create;
3636 fFormat := tfDepth24;
3637 fWithAlpha := tfEmpty;
3638 fWithoutAlpha := tfDepth24;
3639 fglInternalFormat := GL_DEPTH_COMPONENT24;
3642 constructor TfdDepth32.Create;
3645 fFormat := tfDepth32;
3646 fWithAlpha := tfEmpty;
3647 fWithoutAlpha := tfDepth32;
3648 fglInternalFormat := GL_DEPTH_COMPONENT32;
3651 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3652 //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3653 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3654 procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3656 raise EglBitmapException.Create('mapping for compressed formats is not supported');
3659 procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3661 raise EglBitmapException.Create('mapping for compressed formats is not supported');
3664 constructor TfdS3tcDtx1RGBA.Create;
3667 fFormat := tfS3tcDtx1RGBA;
3668 fWithAlpha := tfS3tcDtx1RGBA;
3669 fUncompressed := tfRGB5A1;
3671 fIsCompressed := true;
3672 fglFormat := GL_COMPRESSED_RGBA;
3673 fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
3674 fglDataFormat := GL_UNSIGNED_BYTE;
3677 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3678 //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3679 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3680 procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3682 raise EglBitmapException.Create('mapping for compressed formats is not supported');
3685 procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3687 raise EglBitmapException.Create('mapping for compressed formats is not supported');
3690 constructor TfdS3tcDtx3RGBA.Create;
3693 fFormat := tfS3tcDtx3RGBA;
3694 fWithAlpha := tfS3tcDtx3RGBA;
3695 fUncompressed := tfRGBA8;
3697 fIsCompressed := true;
3698 fglFormat := GL_COMPRESSED_RGBA;
3699 fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
3700 fglDataFormat := GL_UNSIGNED_BYTE;
3703 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3704 //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3705 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3706 procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3708 raise EglBitmapException.Create('mapping for compressed formats is not supported');
3711 procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3713 raise EglBitmapException.Create('mapping for compressed formats is not supported');
3716 constructor TfdS3tcDtx5RGBA.Create;
3719 fFormat := tfS3tcDtx3RGBA;
3720 fWithAlpha := tfS3tcDtx3RGBA;
3721 fUncompressed := tfRGBA8;
3723 fIsCompressed := true;
3724 fglFormat := GL_COMPRESSED_RGBA;
3725 fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
3726 fglDataFormat := GL_UNSIGNED_BYTE;
3729 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3730 //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3731 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3732 class procedure TFormatDescriptor.Init;
3734 if not Assigned(FormatDescriptorCS) then
3735 FormatDescriptorCS := TCriticalSection.Create;
3738 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3739 class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
3741 FormatDescriptorCS.Enter;
3743 result := FormatDescriptors[aFormat];
3744 if not Assigned(result) then begin
3745 result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
3746 FormatDescriptors[aFormat] := result;
3749 FormatDescriptorCS.Leave;
3753 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3754 class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
3756 result := Get(Get(aFormat).WithAlpha);
3759 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3760 class procedure TFormatDescriptor.Clear;
3764 FormatDescriptorCS.Enter;
3766 for f := low(FormatDescriptors) to high(FormatDescriptors) do
3767 FreeAndNil(FormatDescriptors[f]);
3769 FormatDescriptorCS.Leave;
3773 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3774 class procedure TFormatDescriptor.Finalize;
3777 FreeAndNil(FormatDescriptorCS);
3780 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3781 //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3782 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3783 procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
3785 Update(aValue, fRange.r, fShift.r);
3788 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3789 procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
3791 Update(aValue, fRange.g, fShift.g);
3794 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3795 procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
3797 Update(aValue, fRange.b, fShift.b);
3800 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3801 procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
3803 Update(aValue, fRange.a, fShift.a);
3806 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3807 procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
3814 while (aMask > 0) and ((aMask and 1) = 0) do begin
3816 aMask := aMask shr 1;
3819 while (aMask > 0) do begin
3820 aRange := aRange shl 1;
3821 aMask := aMask shr 1;
3825 fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
3828 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3829 procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3835 ((aPixel.Data.r and fRange.r) shl fShift.r) or
3836 ((aPixel.Data.g and fRange.g) shl fShift.g) or
3837 ((aPixel.Data.b and fRange.b) shl fShift.b) or
3838 ((aPixel.Data.a and fRange.a) shl fShift.a);
3839 s := Round(fPixelSize);
3842 2: PWord(aData)^ := data;
3843 4: PCardinal(aData)^ := data;
3844 8: PQWord(aData)^ := data;
3846 raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3851 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3852 procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3857 s := Round(fPixelSize);
3860 2: data := PWord(aData)^;
3861 4: data := PCardinal(aData)^;
3862 8: data := PQWord(aData)^;
3864 raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
3867 aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
3871 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3872 //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3873 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3874 procedure TbmpColorTableFormat.CreateColorTable;
3878 if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3879 raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3881 if (Format = tfLuminance4) then
3882 SetLength(fColorTable, 16)
3884 SetLength(fColorTable, 256);
3888 for i := 0 to High(fColorTable) do begin
3889 fColorTable[i].r := 16 * i;
3890 fColorTable[i].g := 16 * i;
3891 fColorTable[i].b := 16 * i;
3892 fColorTable[i].a := 0;
3897 for i := 0 to High(fColorTable) do begin
3898 fColorTable[i].r := i;
3899 fColorTable[i].g := i;
3900 fColorTable[i].b := i;
3901 fColorTable[i].a := 0;
3906 for i := 0 to High(fColorTable) do begin
3907 fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
3908 fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
3909 fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
3910 fColorTable[i].a := 0;
3916 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3917 procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
3921 if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
3922 raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
3926 if (aMapData = nil) then
3928 d := LuminanceWeight(aPixel) and Range.r;
3929 aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
3931 if ({%H-}PtrUInt(aMapData) >= 8) then begin
3938 aData^ := LuminanceWeight(aPixel) and Range.r;
3944 ((aPixel.Data.r and Range.r) shl Shift.r) or
3945 ((aPixel.Data.g and Range.g) shl Shift.g) or
3946 ((aPixel.Data.b and Range.b) shl Shift.b));
3952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3953 procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
3960 s := Trunc(fPixelSize);
3961 f := fPixelSize - s;
3962 bits := Round(8 * f);
3964 0: idx := (aData^ shr (8 - bits - {%H-}PtrUInt(aMapData))) and ((1 shl bits) - 1);
3966 2: idx := PWord(aData)^;
3967 4: idx := PCardinal(aData)^;
3968 8: idx := PQWord(aData)^;
3970 raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
3972 if (idx >= Length(fColorTable)) then
3973 raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
3974 with fColorTable[idx] do begin
3980 inc(aMapData, bits);
3981 if ({%H-}PtrUInt(aMapData) >= 8) then begin
3988 destructor TbmpColorTableFormat.Destroy;
3990 SetLength(fColorTable, 0);
3994 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3995 //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3996 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
3997 procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
4001 for i := 0 to 3 do begin
4002 if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
4003 if (aSourceFD.Range.arr[i] > 0) then
4004 aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
4006 aPixel.Data.arr[i] := aDestFD.Range.arr[i];
4011 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4012 procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
4014 with aFuncRec do begin
4015 if (Source.Range.r > 0) then
4016 Dest.Data.r := Source.Data.r;
4017 if (Source.Range.g > 0) then
4018 Dest.Data.g := Source.Data.g;
4019 if (Source.Range.b > 0) then
4020 Dest.Data.b := Source.Data.b;
4021 if (Source.Range.a > 0) then
4022 Dest.Data.a := Source.Data.a;
4026 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4027 procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4031 with aFuncRec do begin
4033 if (Source.Range.arr[i] > 0) then
4034 Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
4039 TShiftData = packed record
4041 0: (r, g, b, a: SmallInt);
4042 1: (arr: array[0..3] of SmallInt);
4044 PShiftData = ^TShiftData;
4046 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4047 procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
4053 if (Source.Range.arr[i] > 0) then
4054 Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
4057 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4058 procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
4060 with aFuncRec do begin
4061 Dest.Data := Source.Data;
4062 if ({%H-}PtrUInt(Args) and $1 > 0) then begin
4063 Dest.Data.r := Dest.Data.r xor Dest.Range.r;
4064 Dest.Data.g := Dest.Data.g xor Dest.Range.g;
4065 Dest.Data.b := Dest.Data.b xor Dest.Range.b;
4067 if ({%H-}PtrUInt(Args) and $2 > 0) then begin
4068 Dest.Data.a := Dest.Data.a xor Dest.Range.a;
4073 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4074 procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
4078 with aFuncRec do begin
4080 Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
4084 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4085 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4089 with FuncRec do begin
4090 if (FuncRec.Args = nil) then begin //source has no alpha
4092 Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
4093 Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
4094 Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
4095 Dest.Data.a := Round(Dest.Range.a * Temp);
4097 Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
4101 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4102 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4104 PglBitmapPixelData = ^TglBitmapPixelData;
4106 with FuncRec do begin
4107 Dest.Data.r := Source.Data.r;
4108 Dest.Data.g := Source.Data.g;
4109 Dest.Data.b := Source.Data.b;
4111 with PglBitmapPixelData(Args)^ do
4112 if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
4113 (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
4114 (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
4117 Dest.Data.a := Dest.Range.a;
4121 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4122 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
4124 with FuncRec do begin
4125 Dest.Data.r := Source.Data.r;
4126 Dest.Data.g := Source.Data.g;
4127 Dest.Data.b := Source.Data.b;
4128 Dest.Data.a := PCardinal(Args)^;
4132 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4133 procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
4136 TRGBPix = array [0..2] of byte;
4140 while aWidth > 0 do begin
4141 Temp := PRGBPix(aData)^[0];
4142 PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
4143 PRGBPix(aData)^[2] := Temp;
4153 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4154 //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4155 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4156 function TglBitmap.GetWidth: Integer;
4158 if (ffX in fDimension.Fields) then
4159 result := fDimension.X
4164 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4165 function TglBitmap.GetHeight: Integer;
4167 if (ffY in fDimension.Fields) then
4168 result := fDimension.Y
4173 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4174 function TglBitmap.GetFileWidth: Integer;
4176 result := Max(1, Width);
4179 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4180 function TglBitmap.GetFileHeight: Integer;
4182 result := Max(1, Height);
4185 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4186 procedure TglBitmap.SetCustomData(const aValue: Pointer);
4188 if fCustomData = aValue then
4190 fCustomData := aValue;
4193 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4194 procedure TglBitmap.SetCustomName(const aValue: String);
4196 if fCustomName = aValue then
4198 fCustomName := aValue;
4201 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4202 procedure TglBitmap.SetCustomNameW(const aValue: WideString);
4204 if fCustomNameW = aValue then
4206 fCustomNameW := aValue;
4209 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4210 procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
4212 if fDeleteTextureOnFree = aValue then
4214 fDeleteTextureOnFree := aValue;
4217 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4218 procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
4220 if fFormat = aValue then
4222 if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
4223 raise EglBitmapUnsupportedFormat.Create('SetFormat');
4224 SetDataPointer(Data, aValue, Width, Height);
4227 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4228 procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
4230 if fFreeDataAfterGenTexture = aValue then
4232 fFreeDataAfterGenTexture := aValue;
4235 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4236 procedure TglBitmap.SetID(const aValue: Cardinal);
4238 if fID = aValue then
4243 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4244 procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
4246 if fMipMap = aValue then
4251 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4252 procedure TglBitmap.SetTarget(const aValue: Cardinal);
4254 if fTarget = aValue then
4259 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4260 procedure TglBitmap.SetAnisotropic(const aValue: Integer);
4262 MaxAnisotropic: Integer;
4264 fAnisotropic := aValue;
4265 if (ID > 0) then begin
4266 if GL_EXT_texture_filter_anisotropic then begin
4267 if fAnisotropic > 0 then begin
4269 glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
4270 if aValue > MaxAnisotropic then
4271 fAnisotropic := MaxAnisotropic;
4272 glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
4280 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4281 procedure TglBitmap.CreateID;
4284 glDeleteTextures(1, @fID);
4285 glGenTextures(1, @fID);
4289 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4290 procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
4292 // Set Up Parameters
4293 SetWrap(fWrapS, fWrapT, fWrapR);
4294 SetFilter(fFilterMin, fFilterMag);
4295 SetAnisotropic(fAnisotropic);
4296 SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
4298 // Mip Maps Generation Mode
4299 aBuildWithGlu := false;
4300 if (MipMap = mmMipmap) then begin
4301 if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
4302 glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
4304 aBuildWithGlu := true;
4305 end else if (MipMap = mmMipmapGlu) then
4306 aBuildWithGlu := true;
4309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4310 procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
4311 const aWidth: Integer; const aHeight: Integer);
4315 if (Data <> aData) then begin
4316 if (Assigned(Data)) then
4321 FillChar(fDimension, SizeOf(fDimension), 0);
4322 if not Assigned(fData) then begin
4327 if aWidth <> -1 then begin
4328 fDimension.Fields := fDimension.Fields + [ffX];
4329 fDimension.X := aWidth;
4332 if aHeight <> -1 then begin
4333 fDimension.Fields := fDimension.Fields + [ffY];
4334 fDimension.Y := aHeight;
4337 s := TFormatDescriptor.Get(aFormat).PixelSize;
4339 fPixelSize := Ceil(s);
4340 fRowSize := Ceil(s * aWidth);
4344 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4345 function TglBitmap.FlipHorz: Boolean;
4350 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4351 function TglBitmap.FlipVert: Boolean;
4356 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4357 //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4358 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4359 procedure TglBitmap.AfterConstruction;
4361 inherited AfterConstruction;
4365 fIsResident := false;
4367 fFormat := glBitmapGetDefaultFormat;
4368 fMipMap := glBitmapDefaultMipmap;
4369 fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
4370 fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
4372 glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
4373 glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
4376 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4377 procedure TglBitmap.BeforeDestruction;
4379 SetDataPointer(nil, tfEmpty);
4380 if (fID > 0) and fDeleteTextureOnFree then
4381 glDeleteTextures(1, @fID);
4382 inherited BeforeDestruction;
4385 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4386 procedure TglBitmap.LoadFromFile(const aFilename: String);
4390 if not FileExists(aFilename) then
4391 raise EglBitmapException.Create('file does not exist: ' + aFilename);
4392 fFilename := aFilename;
4393 fs := TFileStream.Create(fFilename, fmOpenRead);
4402 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4403 procedure TglBitmap.LoadFromStream(const aStream: TStream);
4405 {$IFDEF GLB_SUPPORT_PNG_READ}
4406 if not LoadPNG(aStream) then
4408 {$IFDEF GLB_SUPPORT_JPEG_READ}
4409 if not LoadJPEG(aStream) then
4411 if not LoadDDS(aStream) then
4412 if not LoadTGA(aStream) then
4413 if not LoadBMP(aStream) then
4414 raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
4417 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4418 procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
4419 const aFormat: TglBitmapFormat; const aArgs: Pointer);
4424 size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
4425 GetMem(tmpData, size);
4427 FillChar(tmpData^, size, #$FF);
4428 SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
4433 AddFunc(Self, aFunc, false, Format, aArgs);
4437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4438 procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
4440 rs: TResourceStream;
4445 if not Assigned(ResType) then begin
4446 TempPos := Pos('.', Resource);
4447 ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
4448 Resource := UpperCase(Copy(Resource, 0, TempPos -1));
4449 TempResType := PChar(ResTypeStr);
4451 TempResType := ResType
4453 rs := TResourceStream.Create(Instance, Resource, TempResType);
4461 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4462 procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
4464 rs: TResourceStream;
4466 rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
4475 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4476 procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
4480 fs := TFileStream.Create(aFileName, fmCreate);
4483 SaveToStream(fs, aFileType);
4489 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4490 procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
4493 {$IFDEF GLB_SUPPORT_PNG_WRITE}
4494 ftPNG: SavePng(aStream);
4496 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
4497 ftJPEG: SaveJPEG(aStream);
4499 ftDDS: SaveDDS(aStream);
4500 ftTGA: SaveTGA(aStream);
4501 ftBMP: SaveBMP(aStream);
4505 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4506 function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
4508 result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
4511 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4512 function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
4513 const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
4515 DestData, TmpData, SourceData: pByte;
4516 TempHeight, TempWidth: Integer;
4517 SourceFD, DestFD: TFormatDescriptor;
4518 SourceMD, DestMD: Pointer;
4520 FuncRec: TglBitmapFunctionRec;
4522 Assert(Assigned(Data));
4523 Assert(Assigned(aSource));
4524 Assert(Assigned(aSource.Data));
4527 if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
4528 SourceFD := TFormatDescriptor.Get(aSource.Format);
4529 DestFD := TFormatDescriptor.Get(aFormat);
4531 // inkompatible Formats so CreateTemp
4532 if (SourceFD.PixelSize <> DestFD.PixelSize) then
4533 aCreateTemp := true;
4536 TempHeight := Max(1, aSource.Height);
4537 TempWidth := Max(1, aSource.Width);
4539 FuncRec.Sender := Self;
4540 FuncRec.Args := aArgs;
4543 if aCreateTemp then begin
4544 GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));
4545 DestData := TmpData;
4550 SourceFD.PreparePixel(FuncRec.Source);
4551 DestFD.PreparePixel (FuncRec.Dest);
4553 SourceMD := SourceFD.CreateMappingData;
4554 DestMD := DestFD.CreateMappingData;
4556 FuncRec.Size := aSource.Dimension;
4557 FuncRec.Position.Fields := FuncRec.Size.Fields;
4560 SourceData := aSource.Data;
4561 FuncRec.Position.Y := 0;
4562 while FuncRec.Position.Y < TempHeight do begin
4563 FuncRec.Position.X := 0;
4564 while FuncRec.Position.X < TempWidth do begin
4565 SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
4567 DestFD.Map(FuncRec.Dest, DestData, DestMD);
4568 inc(FuncRec.Position.X);
4570 inc(FuncRec.Position.Y);
4573 // Updating Image or InternalFormat
4575 SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
4576 else if (aFormat <> fFormat) then
4581 SourceFD.FreeMappingData(SourceMD);
4582 DestFD.FreeMappingData(DestMD);
4593 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4594 function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
4596 Row, RowSize: Integer;
4597 SourceData, TmpData: PByte;
4599 FormatDesc: TFormatDescriptor;
4601 function GetRowPointer(Row: Integer): pByte;
4603 result := aSurface.pixels;
4604 Inc(result, Row * RowSize);
4610 FormatDesc := TFormatDescriptor.Get(Format);
4611 if FormatDesc.IsCompressed then
4612 raise EglBitmapUnsupportedFormat.Create('AssignToSurface');
4614 if Assigned(Data) then begin
4615 case Trunc(FormatDesc.PixelSize) of
4621 raise EglBitmapUnsupportedFormat.Create('AssignToSurface');
4624 aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
4625 FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
4627 RowSize := FormatDesc.GetSize(FileWidth, 1);
4629 for Row := 0 to FileHeight-1 do begin
4630 TmpData := GetRowPointer(Row);
4631 if Assigned(TmpData) then begin
4632 Move(SourceData^, TmpData^, RowSize);
4633 inc(SourceData, RowSize);
4640 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4641 function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
4643 pSource, pData, pTempData: PByte;
4644 Row, RowSize, TempWidth, TempHeight: Integer;
4645 IntFormat: TglBitmapFormat;
4646 FormatDesc: TFormatDescriptor;
4648 function GetRowPointer(Row: Integer): pByte;
4650 result := aSurface^.pixels;
4651 Inc(result, Row * RowSize);
4656 if (Assigned(aSurface)) then begin
4657 with aSurface^.format^ do begin
4658 for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
4659 FormatDesc := TFormatDescriptor.Get(IntFormat);
4660 if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
4663 if (IntFormat = tfEmpty) then
4664 raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
4667 TempWidth := aSurface^.w;
4668 TempHeight := aSurface^.h;
4669 RowSize := FormatDesc.GetSize(TempWidth, 1);
4670 GetMem(pData, TempHeight * RowSize);
4673 for Row := 0 to TempHeight -1 do begin
4674 pSource := GetRowPointer(Row);
4675 if (Assigned(pSource)) then begin
4676 Move(pSource^, pTempData^, RowSize);
4677 Inc(pTempData, RowSize);
4680 SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4689 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4690 function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
4692 Row, Col, AlphaInterleave: Integer;
4693 pSource, pDest: PByte;
4695 function GetRowPointer(Row: Integer): pByte;
4697 result := aSurface.pixels;
4698 Inc(result, Row * Width);
4703 if Assigned(Data) then begin
4704 if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
4705 aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
4707 AlphaInterleave := 0;
4710 AlphaInterleave := 1;
4712 AlphaInterleave := 3;
4716 for Row := 0 to Height -1 do begin
4717 pDest := GetRowPointer(Row);
4718 if Assigned(pDest) then begin
4719 for Col := 0 to Width -1 do begin
4720 Inc(pSource, AlphaInterleave);
4732 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4733 function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
4737 bmp := TglBitmap2D.Create;
4739 bmp.AssignFromSurface(aSurface);
4740 result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
4748 //TODO rework & test
4749 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4750 function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
4753 pSource, pData: PByte;
4756 if Assigned(Data) then begin
4757 if Assigned(aBitmap) then begin
4758 aBitmap.Width := Width;
4759 aBitmap.Height := Height;
4762 tfAlpha8, ifLuminance, ifDepth8:
4764 Bitmap.PixelFormat := pf8bit;
4765 Bitmap.Palette := CreateGrayPalette;
4768 Bitmap.PixelFormat := pf15bit;
4770 Bitmap.PixelFormat := pf16bit;
4772 Bitmap.PixelFormat := pf24bit;
4774 Bitmap.PixelFormat := pf32bit;
4776 raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
4780 for Row := 0 to FileHeight -1 do begin
4781 pData := Bitmap.Scanline[Row];
4783 Move(pSource^, pData^, fRowSize);
4784 Inc(pSource, fRowSize);
4786 // swap RGB(A) to BGR(A)
4787 if InternalFormat in [ifRGB8, ifRGBA8] then
4788 SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
4796 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4797 function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
4799 pSource, pData, pTempData: PByte;
4800 Row, RowSize, TempWidth, TempHeight: Integer;
4801 IntFormat: TglBitmapInternalFormat;
4805 if (Assigned(Bitmap)) then begin
4806 case Bitmap.PixelFormat of
4808 IntFormat := ifLuminance;
4810 IntFormat := ifRGB5A1;
4812 IntFormat := ifR5G6B5;
4814 IntFormat := ifBGR8;
4816 IntFormat := ifBGRA8;
4818 raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
4821 TempWidth := Bitmap.Width;
4822 TempHeight := Bitmap.Height;
4824 RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
4826 GetMem(pData, TempHeight * RowSize);
4830 for Row := 0 to TempHeight -1 do begin
4831 pSource := Bitmap.Scanline[Row];
4833 if (Assigned(pSource)) then begin
4834 Move(pSource^, pTempData^, RowSize);
4835 Inc(pTempData, RowSize);
4839 SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
4849 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4850 function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
4852 Row, Col, AlphaInterleave: Integer;
4853 pSource, pDest: PByte;
4857 if Assigned(Data) then begin
4858 if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
4859 if Assigned(Bitmap) then begin
4860 Bitmap.PixelFormat := pf8bit;
4861 Bitmap.Palette := CreateGrayPalette;
4862 Bitmap.Width := Width;
4863 Bitmap.Height := Height;
4865 case InternalFormat of
4867 AlphaInterleave := 1;
4869 AlphaInterleave := 3;
4871 AlphaInterleave := 0;
4877 for Row := 0 to Height -1 do begin
4878 pDest := Bitmap.Scanline[Row];
4880 if Assigned(pDest) then begin
4881 for Col := 0 to Width -1 do begin
4882 Inc(pSource, AlphaInterleave);
4896 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4897 function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4901 tex := TglBitmap2D.Create;
4903 tex.AssignFromBitmap(Bitmap);
4904 result := AddAlphaFromglBitmap(tex, Func, CustomData);
4910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4911 function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
4912 const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4914 RS: TResourceStream;
4919 if Assigned(ResType) then
4920 TempResType := ResType
4923 TempPos := Pos('.', Resource);
4924 ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
4925 Resource := UpperCase(Copy(Resource, 0, TempPos -1));
4926 TempResType := PChar(ResTypeStr);
4929 RS := TResourceStream.Create(Instance, Resource, TempResType);
4931 result := AddAlphaFromStream(RS, Func, CustomData);
4937 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4938 function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
4939 const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
4941 RS: TResourceStream;
4943 RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
4945 result := AddAlphaFromStream(RS, Func, CustomData);
4952 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4953 function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4956 if not FormatIsUncompressed(InternalFormat) then
4957 raise EglBitmapUnsupportedFormatFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_FORMAT);
4959 result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
4962 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4963 function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4967 FS := TFileStream.Create(FileName, fmOpenRead);
4969 result := AddAlphaFromStream(FS, aFunc, aArgs);
4975 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4976 function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4980 tex := TglBitmap2D.Create(aStream);
4982 result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
4988 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
4989 function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
4991 DestData, DestData2, SourceData: pByte;
4992 TempHeight, TempWidth: Integer;
4993 SourceFD, DestFD: TFormatDescriptor;
4994 SourceMD, DestMD, DestMD2: Pointer;
4996 FuncRec: TglBitmapFunctionRec;
5000 Assert(Assigned(Data));
5001 Assert(Assigned(aBitmap));
5002 Assert(Assigned(aBitmap.Data));
5004 if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
5005 result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
5007 SourceFD := TFormatDescriptor.Get(aBitmap.Format);
5008 DestFD := TFormatDescriptor.Get(Format);
5010 if not Assigned(aFunc) then begin
5011 aFunc := glBitmapAlphaFunc;
5012 FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
5014 FuncRec.Args := aArgs;
5017 TempHeight := aBitmap.FileHeight;
5018 TempWidth := aBitmap.FileWidth;
5020 FuncRec.Sender := Self;
5021 FuncRec.Size := Dimension;
5022 FuncRec.Position.Fields := FuncRec.Size.Fields;
5026 SourceData := aBitmap.Data;
5029 SourceFD.PreparePixel(FuncRec.Source);
5030 DestFD.PreparePixel (FuncRec.Dest);
5032 SourceMD := SourceFD.CreateMappingData;
5033 DestMD := DestFD.CreateMappingData;
5034 DestMD2 := DestFD.CreateMappingData;
5036 FuncRec.Position.Y := 0;
5037 while FuncRec.Position.Y < TempHeight do begin
5038 FuncRec.Position.X := 0;
5039 while FuncRec.Position.X < TempWidth do begin
5040 SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
5041 DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
5043 DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
5044 inc(FuncRec.Position.X);
5046 inc(FuncRec.Position.Y);
5049 SourceFD.FreeMappingData(SourceMD);
5050 DestFD.FreeMappingData(DestMD);
5051 DestFD.FreeMappingData(DestMD2);
5056 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5057 function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
5059 result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
5062 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5063 function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
5065 PixelData: TglBitmapPixelData;
5067 TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5068 result := AddAlphaFromColorKeyFloat(
5069 aRed / PixelData.Range.r,
5070 aGreen / PixelData.Range.g,
5071 aBlue / PixelData.Range.b,
5072 aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
5075 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5076 function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
5078 values: array[0..2] of Single;
5081 PixelData: TglBitmapPixelData;
5083 TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5084 with PixelData do begin
5086 values[1] := aGreen;
5089 for i := 0 to 2 do begin
5090 tmp := Trunc(Range.arr[i] * aDeviation);
5091 Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
5092 Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
5097 result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
5100 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5101 function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
5103 result := AddAlphaFromValueFloat(aAlpha / $FF);
5106 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5107 function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
5109 PixelData: TglBitmapPixelData;
5111 TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5112 result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
5115 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5116 function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
5118 PixelData: TglBitmapPixelData;
5120 TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5122 Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
5123 result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
5126 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5127 function TglBitmap.RemoveAlpha: Boolean;
5129 FormatDesc: TFormatDescriptor;
5132 FormatDesc := TFormatDescriptor.Get(Format);
5133 if Assigned(Data) then begin
5134 if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
5135 raise EglBitmapUnsupportedFormat.Create('RemoveAlpha');
5136 result := ConvertTo(FormatDesc.WithoutAlpha);
5140 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5141 function TglBitmap.Clone: TglBitmap;
5148 Temp := (ClassType.Create as TglBitmap);
5150 // copy texture data if assigned
5151 if Assigned(Data) then begin
5152 Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
5153 GetMem(TempPtr, Size);
5155 Move(Data^, TempPtr^, Size);
5156 Temp.SetDataPointer(TempPtr, Format, Width, Height);
5162 Temp.SetDataPointer(nil, Format, Width, Height);
5166 Temp.fTarget := Target;
5167 Temp.fFormat := Format;
5168 Temp.fMipMap := MipMap;
5169 Temp.fAnisotropic := Anisotropic;
5170 Temp.fBorderColor := fBorderColor;
5171 Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
5172 Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
5173 Temp.fFilterMin := fFilterMin;
5174 Temp.fFilterMag := fFilterMag;
5175 Temp.fWrapS := fWrapS;
5176 Temp.fWrapT := fWrapT;
5177 Temp.fWrapR := fWrapR;
5178 Temp.fFilename := fFilename;
5179 Temp.fCustomName := fCustomName;
5180 Temp.fCustomNameW := fCustomNameW;
5181 Temp.fCustomData := fCustomData;
5190 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5191 function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
5193 SourceFD, DestFD: TFormatDescriptor;
5194 SourcePD, DestPD: TglBitmapPixelData;
5195 ShiftData: TShiftData;
5197 function CanCopyDirect: Boolean;
5200 ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5201 ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5202 ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5203 ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5206 function CanShift: Boolean;
5209 ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
5210 ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
5211 ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
5212 ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
5215 function GetShift(aSource, aDest: Cardinal) : ShortInt;
5218 while (aSource > aDest) and (aSource > 0) do begin
5220 aSource := aSource shr 1;
5225 if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
5226 SourceFD := TFormatDescriptor.Get(Format);
5227 DestFD := TFormatDescriptor.Get(aFormat);
5229 SourceFD.PreparePixel(SourcePD);
5230 DestFD.PreparePixel (DestPD);
5232 if CanCopyDirect then
5233 result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
5234 else if CanShift then begin
5235 ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
5236 ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
5237 ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
5238 ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
5239 result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
5241 result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
5246 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5247 procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
5249 if aUseRGB or aUseAlpha then
5250 AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
5251 ((PtrInt(aUseAlpha) and 1) shl 1) or
5252 (PtrInt(aUseRGB) and 1) ));
5255 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5256 procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
5258 fBorderColor[0] := aRed;
5259 fBorderColor[1] := aGreen;
5260 fBorderColor[2] := aBlue;
5261 fBorderColor[3] := aAlpha;
5262 if (ID > 0) then begin
5264 glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5268 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5269 procedure TglBitmap.FreeData;
5271 SetDataPointer(nil, tfEmpty);
5274 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5275 procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
5276 const aAlpha: Byte);
5278 FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
5281 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5282 procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
5284 PixelData: TglBitmapPixelData;
5286 TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
5288 aRed / PixelData.Range.r,
5289 aGreen / PixelData.Range.g,
5290 aBlue / PixelData.Range.b,
5291 aAlpha / PixelData.Range.a);
5294 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5295 procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
5297 PixelData: TglBitmapPixelData;
5299 TFormatDescriptor.Get(Format).PreparePixel(PixelData);
5300 with PixelData do begin
5301 Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
5302 Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
5303 Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
5304 Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
5306 AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
5309 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5310 procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
5315 fFilterMin := GL_NEAREST;
5317 fFilterMin := GL_LINEAR;
5318 GL_NEAREST_MIPMAP_NEAREST:
5319 fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
5320 GL_LINEAR_MIPMAP_NEAREST:
5321 fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
5322 GL_NEAREST_MIPMAP_LINEAR:
5323 fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
5324 GL_LINEAR_MIPMAP_LINEAR:
5325 fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
5327 raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
5333 fFilterMag := GL_NEAREST;
5335 fFilterMag := GL_LINEAR;
5337 raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
5341 if (ID > 0) then begin
5343 glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
5345 if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
5347 GL_NEAREST, GL_LINEAR:
5348 glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5349 GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
5350 glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
5351 GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
5352 glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
5355 glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
5359 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5360 procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
5362 procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
5366 aTarget := GL_CLAMP;
5369 aTarget := GL_REPEAT;
5371 GL_CLAMP_TO_EDGE: begin
5372 if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
5373 aTarget := GL_CLAMP_TO_EDGE
5375 aTarget := GL_CLAMP;
5378 GL_CLAMP_TO_BORDER: begin
5379 if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
5380 aTarget := GL_CLAMP_TO_BORDER
5382 aTarget := GL_CLAMP;
5385 GL_MIRRORED_REPEAT: begin
5386 if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
5387 aTarget := GL_MIRRORED_REPEAT
5389 raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
5392 raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
5397 CheckAndSetWrap(S, fWrapS);
5398 CheckAndSetWrap(T, fWrapT);
5399 CheckAndSetWrap(R, fWrapR);
5401 if (ID > 0) then begin
5403 glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
5404 glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
5405 glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
5409 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5410 procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
5412 if aEnableTextureUnit then
5415 glBindTexture(Target, ID);
5418 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5419 procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
5421 if aDisableTextureUnit then
5423 glBindTexture(Target, 0);
5426 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5427 constructor TglBitmap.Create;
5429 {$IFDEF GLB_NATIVE_OGL}
5430 glbReadOpenGLExtensions;
5432 if (ClassType = TglBitmap) then
5433 raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
5437 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5438 constructor TglBitmap.Create(const aFileName: String);
5441 LoadFromFile(FileName);
5444 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5445 constructor TglBitmap.Create(const aStream: TStream);
5448 LoadFromStream(aStream);
5451 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5452 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
5458 ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
5459 GetMem(Image, ImageSize);
5461 FillChar(Image^, ImageSize, #$FF);
5462 SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
5469 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5470 constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
5471 const aFunc: TglBitmapFunction; const aArgs: Pointer);
5474 LoadFromFunc(aSize, aFunc, aFormat, aArgs);
5478 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5479 constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
5482 LoadFromResource(aInstance, aResource, aResType);
5485 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5486 constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
5489 LoadFromResourceID(aInstance, aResourceID, aResType);
5493 {$IFDEF GLB_SUPPORT_PNG_READ}
5494 {$IF DEFINED(GLB_SDL_IMAGE)}
5495 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5496 //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5497 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5498 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5500 Surface: PSDL_Surface;
5504 RWops := glBitmapCreateRWops(aStream);
5506 if IMG_isPNG(RWops) > 0 then begin
5507 Surface := IMG_LoadPNG_RW(RWops);
5509 AssignFromSurface(Surface);
5512 SDL_FreeSurface(Surface);
5520 {$ELSEIF DEFINED(GLB_LIB_PNG)}
5521 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5522 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5524 TStream(png_get_io_ptr(png)).Read(buffer^, size);
5527 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5528 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5531 signature: array [0..7] of byte;
5533 png_info: png_infop;
5535 TempHeight, TempWidth: Integer;
5536 Format: TglBitmapInternalFormat;
5539 png_rows: array of pByte;
5540 Row, LineSize: Integer;
5544 if not init_libPNG then
5545 raise Exception.Create('LoadPNG - unable to initialize libPNG.');
5549 StreamPos := Stream.Position;
5550 Stream.Read(signature, 8);
5551 Stream.Position := StreamPos;
5553 if png_check_sig(@signature, 8) <> 0 then begin
5555 png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5557 raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
5560 png_info := png_create_info_struct(png);
5561 if png_info = nil then begin
5562 png_destroy_read_struct(@png, nil, nil);
5563 raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
5566 // set read callback
5567 png_set_read_fn(png, stream, glBitmap_libPNG_read_func);
5569 // read informations
5570 png_read_info(png, png_info);
5573 TempHeight := png_get_image_height(png, png_info);
5574 TempWidth := png_get_image_width(png, png_info);
5577 case png_get_color_type(png, png_info) of
5578 PNG_COLOR_TYPE_GRAY:
5579 Format := tfLuminance8;
5580 PNG_COLOR_TYPE_GRAY_ALPHA:
5581 Format := tfLuminance8Alpha8;
5584 PNG_COLOR_TYPE_RGB_ALPHA:
5587 raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5590 // cut upper 8 bit from 16 bit formats
5591 if png_get_bit_depth(png, png_info) > 8 then
5592 png_set_strip_16(png);
5594 // expand bitdepth smaller than 8
5595 if png_get_bit_depth(png, png_info) < 8 then
5596 png_set_expand(png);
5598 // allocating mem for scanlines
5599 LineSize := png_get_rowbytes(png, png_info);
5600 GetMem(png_data, TempHeight * LineSize);
5602 SetLength(png_rows, TempHeight);
5603 for Row := Low(png_rows) to High(png_rows) do begin
5604 png_rows[Row] := png_data;
5605 Inc(png_rows[Row], Row * LineSize);
5608 // read complete image into scanlines
5609 png_read_image(png, @png_rows[0]);
5612 png_read_end(png, png_info);
5614 // destroy read struct
5615 png_destroy_read_struct(@png, @png_info, nil);
5617 SetLength(png_rows, 0);
5620 SetDataPointer(png_data, Format, TempWidth, TempHeight);
5633 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5634 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5635 function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
5639 Header: Array[0..7] of Byte;
5640 Row, Col, PixSize, LineSize: Integer;
5641 NewImage, pSource, pDest, pAlpha: pByte;
5642 Format: TglBitmapInternalFormat;
5645 PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
5650 StreamPos := Stream.Position;
5651 Stream.Read(Header[0], SizeOf(Header));
5652 Stream.Position := StreamPos;
5654 {Test if the header matches}
5655 if Header = PngHeader then begin
5656 Png := TPNGObject.Create;
5658 Png.LoadFromStream(Stream);
5660 case Png.Header.ColorType of
5662 Format := ifLuminance;
5663 COLOR_GRAYSCALEALPHA:
5664 Format := ifLuminanceAlpha;
5670 raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5673 PixSize := Trunc(FormatGetSize(Format));
5674 LineSize := Integer(Png.Header.Width) * PixSize;
5676 GetMem(NewImage, LineSize * Integer(Png.Header.Height));
5680 case Png.Header.ColorType of
5681 COLOR_RGB, COLOR_GRAYSCALE:
5683 for Row := 0 to Png.Height -1 do begin
5684 Move (Png.Scanline[Row]^, pDest^, LineSize);
5685 Inc(pDest, LineSize);
5688 COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
5690 PixSize := PixSize -1;
5692 for Row := 0 to Png.Height -1 do begin
5693 pSource := Png.Scanline[Row];
5694 pAlpha := pByte(Png.AlphaScanline[Row]);
5696 for Col := 0 to Png.Width -1 do begin
5697 Move (pSource^, pDest^, PixSize);
5698 Inc(pSource, PixSize);
5699 Inc(pDest, PixSize);
5708 raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
5711 SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
5726 {$IFDEF GLB_SUPPORT_PNG_WRITE}
5727 {$IFDEF GLB_LIB_PNG}
5728 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5729 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
5731 TStream(png_get_io_ptr(png)).Write(buffer^, size);
5735 {$IF DEFINED(GLB_LIB_PNG)}
5736 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5737 procedure TglBitmap.SavePNG(const aStream: TStream);
5740 png_info: png_infop;
5741 png_rows: array of pByte;
5746 if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
5747 raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5749 if not init_libPNG then
5750 raise Exception.Create('SavePNG - unable to initialize libPNG.');
5753 case FInternalFormat of
5754 ifAlpha, ifLuminance, ifDepth8:
5755 ColorType := PNG_COLOR_TYPE_GRAY;
5757 ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
5759 ColorType := PNG_COLOR_TYPE_RGB;
5761 ColorType := PNG_COLOR_TYPE_RGBA;
5763 raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5765 LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);
5767 // creating array for scanline
5768 SetLength(png_rows, Height);
5770 for Row := 0 to Height - 1 do begin
5771 png_rows[Row] := Data;
5772 Inc(png_rows[Row], Row * LineSize)
5776 png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
5778 raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
5781 png_info := png_create_info_struct(png);
5782 if png_info = nil then begin
5783 png_destroy_write_struct(@png, nil);
5784 raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
5787 // set read callback
5788 png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);
5791 png_set_compression_level(png, 6);
5793 if InternalFormat in [ifBGR8, ifBGRA8] then
5796 png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
5797 png_write_info(png, png_info);
5798 png_write_image(png, @png_rows[0]);
5799 png_write_end(png, png_info);
5800 png_destroy_write_struct(@png, @png_info);
5802 SetLength(png_rows, 0);
5809 {$ELSEIF DEFINED(GLB_PNGIMAGE)}
5810 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5811 procedure TglBitmap.SavePNG(const aStream: TStream);
5815 pSource, pDest: pByte;
5816 X, Y, PixSize: Integer;
5817 ColorType: Cardinal;
5823 if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
5824 raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5826 case FInternalFormat of
5827 ifAlpha, ifLuminance, ifDepth8: begin
5828 ColorType := COLOR_GRAYSCALE;
5832 ifLuminanceAlpha: begin
5833 ColorType := COLOR_GRAYSCALEALPHA;
5837 ifBGR8, ifRGB8: begin
5838 ColorType := COLOR_RGB;
5842 ifBGRA8, ifRGBA8: begin
5843 ColorType := COLOR_RGBALPHA;
5848 raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
5851 Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
5855 for Y := 0 to Height -1 do begin
5856 pDest := png.ScanLine[Y];
5857 for X := 0 to Width -1 do begin
5858 Move(pSource^, pDest^, PixSize);
5859 Inc(pDest, PixSize);
5860 Inc(pSource, PixSize);
5862 png.AlphaScanline[Y]^[X] := pSource^;
5867 // convert RGB line to BGR
5868 if InternalFormat in [ifRGB8, ifRGBA8] then begin
5869 pTemp := png.ScanLine[Y];
5870 for X := 0 to Width -1 do begin
5871 Temp := pByteArray(pTemp)^[0];
5872 pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
5873 pByteArray(pTemp)^[2] := Temp;
5880 Png.CompressionLevel := 6;
5881 Png.SaveToStream(Stream);
5889 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5890 //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5891 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5892 {$IFDEF GLB_LIB_JPEG}
5894 glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
5895 glBitmap_libJPEG_source_mgr = record
5896 pub: jpeg_source_mgr;
5899 SrcBuffer: array [1..4096] of byte;
5902 glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
5903 glBitmap_libJPEG_dest_mgr = record
5904 pub: jpeg_destination_mgr;
5906 DestStream: TStream;
5907 DestBuffer: array [1..4096] of byte;
5910 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5911 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
5913 src: glBitmap_libJPEG_source_mgr_ptr;
5916 src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5918 bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
5919 if (bytes <= 0) then begin
5920 src^.SrcBuffer[1] := $FF;
5921 src^.SrcBuffer[2] := JPEG_EOI;
5925 src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
5926 src^.pub.bytes_in_buffer := bytes;
5931 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5932 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
5934 src: glBitmap_libJPEG_source_mgr_ptr;
5936 src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
5938 if num_bytes > 0 then begin
5939 // wanted byte isn't in buffer so set stream position and read buffer
5940 if num_bytes > src^.pub.bytes_in_buffer then begin
5941 src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
5942 src^.pub.fill_input_buffer(cinfo);
5944 // wanted byte is in buffer so only skip
5945 inc(src^.pub.next_input_byte, num_bytes);
5946 dec(src^.pub.bytes_in_buffer, num_bytes);
5951 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5952 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
5954 dest: glBitmap_libJPEG_dest_mgr_ptr;
5956 dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5958 if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
5959 // write complete buffer
5960 dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
5963 dest^.pub.next_output_byte := @dest^.DestBuffer[1];
5964 dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
5970 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5971 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
5974 dest: glBitmap_libJPEG_dest_mgr_ptr;
5976 dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
5978 for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
5979 // check for endblock
5980 if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
5982 dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
5987 dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
5992 {$IFDEF GLB_SUPPORT_JPEG_READ}
5993 {$IF DEFINED(GLB_SDL_IMAGE)}
5994 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
5995 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
5997 Surface: PSDL_Surface;
6002 RWops := glBitmapCreateRWops(aStream);
6004 if IMG_isJPG(RWops) > 0 then begin
6005 Surface := IMG_LoadJPG_RW(RWops);
6007 AssignFromSurface(Surface);
6010 SDL_FreeSurface(Surface);
6018 {$ELSEIF DEFINED(GLB_LIB_JPEG)}
6019 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6020 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6023 Temp: array[0..1]of Byte;
6025 jpeg: jpeg_decompress_struct;
6026 jpeg_err: jpeg_error_mgr;
6028 IntFormat: TglBitmapInternalFormat;
6030 TempHeight, TempWidth: Integer;
6037 if not init_libJPEG then
6038 raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
6041 // reading first two bytes to test file and set cursor back to begin
6042 StreamPos := Stream.Position;
6043 Stream.Read(Temp[0], 2);
6044 Stream.Position := StreamPos;
6046 // if Bitmap then read file.
6047 if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6048 FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
6049 FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
6052 jpeg.err := jpeg_std_error(@jpeg_err);
6053 jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
6054 jpeg_err.output_message := glBitmap_libJPEG_output_message;
6056 // decompression struct
6057 jpeg_create_decompress(@jpeg);
6059 // allocation space for streaming methods
6060 jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
6062 // seeting up custom functions
6063 with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
6064 pub.init_source := glBitmap_libJPEG_init_source;
6065 pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
6066 pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
6067 pub.resync_to_restart := jpeg_resync_to_restart; // use default method
6068 pub.term_source := glBitmap_libJPEG_term_source;
6070 pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
6071 pub.next_input_byte := nil; // until buffer loaded
6073 SrcStream := Stream;
6076 // set global decoding state
6077 jpeg.global_state := DSTATE_START;
6079 // read header of jpeg
6080 jpeg_read_header(@jpeg, false);
6082 // setting output parameter
6083 case jpeg.jpeg_color_space of
6086 jpeg.out_color_space := JCS_GRAYSCALE;
6087 IntFormat := ifLuminance;
6090 jpeg.out_color_space := JCS_RGB;
6091 IntFormat := ifRGB8;
6095 jpeg_start_decompress(@jpeg);
6097 TempHeight := jpeg.output_height;
6098 TempWidth := jpeg.output_width;
6100 // creating new image
6101 GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
6105 for Row := 0 to TempHeight -1 do begin
6106 jpeg_read_scanlines(@jpeg, @pTemp, 1);
6107 Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
6110 // finish decompression
6111 jpeg_finish_decompress(@jpeg);
6113 // destroy decompression
6114 jpeg_destroy_decompress(@jpeg);
6116 SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
6129 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6130 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6131 function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
6136 Temp: array[0..1]of Byte;
6140 // reading first two bytes to test file and set cursor back to begin
6141 StreamPos := Stream.Position;
6142 Stream.Read(Temp[0], 2);
6143 Stream.Position := StreamPos;
6145 // if Bitmap then read file.
6146 if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
6147 bmp := TBitmap.Create;
6149 jpg := TJPEGImage.Create;
6151 jpg.LoadFromStream(Stream);
6153 result := AssignFromBitmap(bmp);
6165 {$IFDEF GLB_SUPPORT_JPEG_WRITE}
6166 {$IF DEFEFINED(GLB_LIB_JPEG)}
6167 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6168 procedure TglBitmap.SaveJPEG(Stream: TStream);
6170 jpeg: jpeg_compress_struct;
6171 jpeg_err: jpeg_error_mgr;
6173 pTemp, pTemp2: pByte;
6175 procedure CopyRow(pDest, pSource: pByte);
6179 for X := 0 to Width - 1 do begin
6180 pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
6181 pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
6182 pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
6189 if not (ftJPEG in FormatGetSupportedFiles(Format)) then
6190 raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
6192 if not init_libJPEG then
6193 raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
6196 FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
6197 FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
6200 jpeg.err := jpeg_std_error(@jpeg_err);
6201 jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
6202 jpeg_err.output_message := glBitmap_libJPEG_output_message;
6204 // compression struct
6205 jpeg_create_compress(@jpeg);
6207 // allocation space for streaming methods
6208 jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
6210 // seeting up custom functions
6211 with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
6212 pub.init_destination := glBitmap_libJPEG_init_destination;
6213 pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
6214 pub.term_destination := glBitmap_libJPEG_term_destination;
6216 pub.next_output_byte := @DestBuffer[1];
6217 pub.free_in_buffer := Length(DestBuffer);
6219 DestStream := Stream;
6222 // very important state
6223 jpeg.global_state := CSTATE_START;
6224 jpeg.image_width := Width;
6225 jpeg.image_height := Height;
6226 case InternalFormat of
6227 ifAlpha, ifLuminance, ifDepth8: begin
6228 jpeg.input_components := 1;
6229 jpeg.in_color_space := JCS_GRAYSCALE;
6231 ifRGB8, ifBGR8: begin
6232 jpeg.input_components := 3;
6233 jpeg.in_color_space := JCS_RGB;
6237 jpeg_set_defaults(@jpeg);
6238 jpeg_set_quality(@jpeg, 95, true);
6239 jpeg_start_compress(@jpeg, true);
6242 if InternalFormat = ifBGR8 then
6243 GetMem(pTemp2, fRowSize)
6248 for Row := 0 to jpeg.image_height -1 do begin
6250 if InternalFormat = ifBGR8 then
6251 CopyRow(pTemp2, pTemp)
6256 jpeg_write_scanlines(@jpeg, @pTemp2, 1);
6257 inc(pTemp, fRowSize);
6261 if InternalFormat = ifBGR8 then
6264 jpeg_finish_compress(@jpeg);
6265 jpeg_destroy_compress(@jpeg);
6271 {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
6272 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6273 procedure TglBitmap.SaveJPEG(Stream: TStream);
6278 if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
6279 raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
6281 Bmp := TBitmap.Create;
6283 Jpg := TJPEGImage.Create;
6285 AssignToBitmap(Bmp);
6286 if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
6287 Jpg.Grayscale := true;
6288 Jpg.PixelFormat := jf8Bit;
6291 Jpg.SaveToStream(Stream);
6302 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6303 //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6304 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6311 BMP_COMP_BITFIELDS = 3;
6314 TBMPHeader = packed record
6319 bfOffBits: Cardinal;
6322 TBMPInfo = packed record
6328 biCompression: Cardinal;
6329 biSizeImage: Cardinal;
6330 biXPelsPerMeter: Longint;
6331 biYPelsPerMeter: Longint;
6332 biClrUsed: Cardinal;
6333 biClrImportant: Cardinal;
6336 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6337 function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
6339 //////////////////////////////////////////////////////////////////////////////////////////////////
6340 function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
6343 aStream.Read(aInfo{%H-}, SizeOf(aInfo));
6344 FillChar(aMask{%H-}, SizeOf(aMask), 0);
6347 case aInfo.biCompression of
6349 BMP_COMP_RLE8: begin
6350 raise EglBitmapException.Create('RLE compression is not supported');
6352 BMP_COMP_BITFIELDS: begin
6353 if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
6354 aStream.Read(aMask.r, SizeOf(aMask.r));
6355 aStream.Read(aMask.g, SizeOf(aMask.g));
6356 aStream.Read(aMask.b, SizeOf(aMask.b));
6357 aStream.Read(aMask.a, SizeOf(aMask.a));
6359 raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
6363 //get suitable format
6364 case aInfo.biBitCount of
6365 8: result := tfLuminance8;
6366 16: result := tfBGR5;
6367 24: result := tfBGR8;
6368 32: result := tfBGRA8;
6372 function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
6375 ColorTable: TbmpColorTable;
6378 if (aInfo.biBitCount >= 16) then
6380 aFormat := tfLuminance8;
6381 c := aInfo.biClrUsed;
6383 c := 1 shl aInfo.biBitCount;
6384 SetLength(ColorTable, c);
6385 for i := 0 to c-1 do begin
6386 aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
6387 if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
6391 result := TbmpColorTableFormat.Create;
6392 result.PixelSize := aInfo.biBitCount / 8;
6393 result.ColorTable := ColorTable;
6394 result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
6397 //////////////////////////////////////////////////////////////////////////////////////////////////
6398 function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
6399 const aInfo: TBMPInfo): TbmpBitfieldFormat;
6401 TmpFormat: TglBitmapFormat;
6402 FormatDesc: TFormatDescriptor;
6405 if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
6406 for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
6407 FormatDesc := TFormatDescriptor.Get(TmpFormat);
6408 if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
6409 aFormat := FormatDesc.Format;
6414 if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
6415 aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
6416 if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
6417 aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
6419 result := TbmpBitfieldFormat.Create;
6420 result.PixelSize := aInfo.biBitCount / 8;
6421 result.RedMask := aMask.r;
6422 result.GreenMask := aMask.g;
6423 result.BlueMask := aMask.b;
6424 result.AlphaMask := aMask.a;
6431 ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
6432 PaddingBuff: Cardinal;
6433 LineBuf, ImageData, TmpData: PByte;
6434 SourceMD, DestMD: Pointer;
6435 BmpFormat: TglBitmapFormat;
6438 Mask: TglBitmapColorRec;
6443 SpecialFormat: TFormatDescriptor;
6444 FormatDesc: TFormatDescriptor;
6446 //////////////////////////////////////////////////////////////////////////////////////////////////
6447 procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
6450 Pixel: TglBitmapPixelData;
6452 aStream.Read(aLineBuf^, rbLineSize);
6453 SpecialFormat.PreparePixel(Pixel);
6454 for i := 0 to Info.biWidth-1 do begin
6455 SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
6456 glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
6457 FormatDesc.Map(Pixel, aData, DestMD);
6463 BmpFormat := tfEmpty;
6464 SpecialFormat := nil;
6470 StartPos := aStream.Position;
6471 aStream.Read(Header{%H-}, SizeOf(Header));
6473 if Header.bfType = BMP_MAGIC then begin
6475 BmpFormat := ReadInfo(Info, Mask);
6476 SpecialFormat := ReadColorTable(BmpFormat, Info);
6477 if not Assigned(SpecialFormat) then
6478 SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
6479 aStream.Position := StartPos + Header.bfOffBits;
6481 if (BmpFormat <> tfEmpty) then begin
6482 FormatDesc := TFormatDescriptor.Get(BmpFormat);
6483 rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
6484 wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
6485 Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
6488 DestMD := FormatDesc.CreateMappingData;
6489 ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
6490 GetMem(ImageData, ImageSize);
6491 if Assigned(SpecialFormat) then begin
6492 GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
6493 SourceMD := SpecialFormat.CreateMappingData;
6498 FillChar(ImageData^, ImageSize, $FF);
6499 TmpData := ImageData;
6500 if (Info.biHeight > 0) then
6501 Inc(TmpData, wbLineSize * (Info.biHeight-1));
6502 for i := 0 to Abs(Info.biHeight)-1 do begin
6503 if Assigned(SpecialFormat) then
6504 SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
6506 aStream.Read(TmpData^, wbLineSize); //else only read data
6507 if (Info.biHeight > 0) then
6508 dec(TmpData, wbLineSize)
6510 inc(TmpData, wbLineSize);
6511 aStream.Read(PaddingBuff{%H-}, Padding);
6513 SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
6516 if Assigned(LineBuf) then
6518 if Assigned(SourceMD) then
6519 SpecialFormat.FreeMappingData(SourceMD);
6520 FormatDesc.FreeMappingData(DestMD);
6527 raise EglBitmapException.Create('LoadBMP - No suitable format found');
6529 aStream.Position := StartPos;
6533 FreeAndNil(SpecialFormat);
6536 else aStream.Position := StartPos;
6539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6540 procedure TglBitmap.SaveBMP(const aStream: TStream);
6544 Converter: TbmpColorTableFormat;
6545 FormatDesc: TFormatDescriptor;
6546 SourceFD, DestFD: Pointer;
6547 pData, srcData, dstData, ConvertBuffer: pByte;
6549 Pixel: TglBitmapPixelData;
6550 ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
6551 RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
6553 PaddingBuff: Cardinal;
6555 function GetLineWidth : Integer;
6557 result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
6561 if not (ftBMP in FormatGetSupportedFiles(Format)) then
6562 raise EglBitmapUnsupportedFormat.Create('SaveBMP');
6565 FormatDesc := TFormatDescriptor.Get(Format);
6566 ImageSize := FormatDesc.GetSize(Dimension);
6568 FillChar(Header{%H-}, SizeOf(Header), 0);
6569 Header.bfType := BMP_MAGIC;
6570 Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
6571 Header.bfReserved1 := 0;
6572 Header.bfReserved2 := 0;
6573 Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
6575 FillChar(Info{%H-}, SizeOf(Info), 0);
6576 Info.biSize := SizeOf(Info);
6577 Info.biWidth := Width;
6578 Info.biHeight := Height;
6580 Info.biCompression := BMP_COMP_RGB;
6581 Info.biSizeImage := ImageSize;
6586 Info.biBitCount := 4;
6587 Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
6588 Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
6589 Converter := TbmpColorTableFormat.Create;
6590 Converter.PixelSize := 0.5;
6591 Converter.Format := Format;
6592 Converter.Range := glBitmapColorRec($F, $F, $F, $0);
6593 Converter.CreateColorTable;
6596 tfR3G3B2, tfLuminance8: begin
6597 Info.biBitCount := 8;
6598 Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
6599 Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
6600 Converter := TbmpColorTableFormat.Create;
6601 Converter.PixelSize := 1;
6602 Converter.Format := Format;
6603 if (Format = tfR3G3B2) then begin
6604 Converter.Range := glBitmapColorRec($7, $7, $3, $0);
6605 Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
6607 Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
6608 Converter.CreateColorTable;
6611 tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
6612 tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
6613 Info.biBitCount := 16;
6614 Info.biCompression := BMP_COMP_BITFIELDS;
6617 tfBGR8, tfRGB8: begin
6618 Info.biBitCount := 24;
6621 tfRGB10, tfRGB10A2, tfRGBA8,
6622 tfBGR10, tfBGR10A2, tfBGRA8: begin
6623 Info.biBitCount := 32;
6624 Info.biCompression := BMP_COMP_BITFIELDS;
6627 raise EglBitmapUnsupportedFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
6629 Info.biXPelsPerMeter := 2835;
6630 Info.biYPelsPerMeter := 2835;
6633 if Info.biCompression = BMP_COMP_BITFIELDS then begin
6634 Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
6635 Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
6637 RedMask := FormatDesc.RedMask;
6638 GreenMask := FormatDesc.GreenMask;
6639 BlueMask := FormatDesc.BlueMask;
6640 AlphaMask := FormatDesc.AlphaMask;
6644 aStream.Write(Header, SizeOf(Header));
6645 aStream.Write(Info, SizeOf(Info));
6648 if Assigned(Converter) then
6649 aStream.Write(Converter.ColorTable[0].b,
6650 SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
6653 if Info.biCompression = BMP_COMP_BITFIELDS then begin
6654 aStream.Write(RedMask, SizeOf(Cardinal));
6655 aStream.Write(GreenMask, SizeOf(Cardinal));
6656 aStream.Write(BlueMask, SizeOf(Cardinal));
6657 aStream.Write(AlphaMask, SizeOf(Cardinal));
6661 rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
6662 wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
6663 Padding := GetLineWidth - wbLineSize;
6667 inc(pData, (Height-1) * rbLineSize);
6669 // prepare row buffer. But only for RGB because RGBA supports color masks
6670 // so it's possible to change color within the image.
6671 if Assigned(Converter) then begin
6672 FormatDesc.PreparePixel(Pixel);
6673 GetMem(ConvertBuffer, wbLineSize);
6674 SourceFD := FormatDesc.CreateMappingData;
6675 DestFD := Converter.CreateMappingData;
6677 ConvertBuffer := nil;
6680 for LineIdx := 0 to Height - 1 do begin
6682 if Assigned(Converter) then begin
6684 dstData := ConvertBuffer;
6685 for PixelIdx := 0 to Info.biWidth-1 do begin
6686 FormatDesc.Unmap(srcData, Pixel, SourceFD);
6687 glBitmapConvertPixel(Pixel, FormatDesc, Converter);
6688 Converter.Map(Pixel, dstData, DestFD);
6690 aStream.Write(ConvertBuffer^, wbLineSize);
6692 aStream.Write(pData^, rbLineSize);
6694 dec(pData, rbLineSize);
6695 if (Padding > 0) then
6696 aStream.Write(PaddingBuff, Padding);
6699 // destroy row buffer
6700 if Assigned(ConvertBuffer) then begin
6701 FormatDesc.FreeMappingData(SourceFD);
6702 Converter.FreeMappingData(DestFD);
6703 FreeMem(ConvertBuffer);
6707 if Assigned(Converter) then
6712 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6713 //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6714 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6716 TTGAHeader = packed record
6720 //ColorMapSpec: Array[0..4] of Byte;
6721 ColorMapStart: Word;
6722 ColorMapLength: Word;
6723 ColorMapEntrySize: Byte;
6733 TGA_UNCOMPRESSED_RGB = 2;
6734 TGA_UNCOMPRESSED_GRAY = 3;
6735 TGA_COMPRESSED_RGB = 10;
6736 TGA_COMPRESSED_GRAY = 11;
6738 TGA_NONE_COLOR_TABLE = 0;
6740 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
6741 function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
6744 ImageData: System.PByte;
6745 StartPosition: Int64;
6746 PixelSize, LineSize: Integer;
6747 tgaFormat: TglBitmapFormat;
6748 FormatDesc: TFormatDescriptor;
6749 Counter: packed record
6751 low, high, dir: Integer;
6758 ////////////////////////////////////////////////////////////////////////////////////////
6759 procedure ReadUncompressed;
6762 buf, tmp1, tmp2: System.PByte;
6765 if (Counter.X.dir < 0) then
6766 buf := GetMem(LineSize);
6768 while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
6769 tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
6770 if (Counter.X.dir < 0) then begin //flip X
6771 aStream.Read(buf^, LineSize);
6772 tmp2 := buf + LineSize - PixelSize; //pointer to last pixel in line
6773 for i := 0 to Header.Width-1 do begin //for all pixels in line
6774 for j := 0 to PixelSize-1 do begin //for all bytes in pixel
6779 dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
6782 aStream.Read(tmp1^, LineSize);
6783 inc(Counter.Y.low, Counter.Y.dir); //move to next line index
6786 if Assigned(buf) then
6791 ////////////////////////////////////////////////////////////////////////////////////////
6792 procedure ReadCompressed;
6794 /////////////////////////////////////////////////////////////////
6796 TmpData: System.PByte;
6797 LinePixelsRead: Integer;
6798 procedure CheckLine;
6800 if (LinePixelsRead >= Header.Width) then begin
6801 LinePixelsRead := 0;
6802 inc(Counter.Y.low, Counter.Y.dir); //next line index
6803 TmpData := ImageData + Counter.Y.low * LineSize; //set line
6804 if (Counter.X.dir < 0) then //if x flipped then
6805 TmpData := TmpData + LineSize - PixelSize; //set last pixel
6809 /////////////////////////////////////////////////////////////////
6812 CacheSize, CachePos: Integer;
6813 procedure CachedRead(out Buffer; Count: Integer);
6817 if (CachePos + Count > CacheSize) then begin
6818 //if buffer overflow save non read bytes
6820 if (CacheSize - CachePos > 0) then begin
6821 BytesRead := CacheSize - CachePos;
6822 Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
6823 inc(CachePos, BytesRead);
6826 //load cache from file
6827 CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
6828 aStream.Read(Cache^, CacheSize);
6831 //read rest of requested bytes
6832 if (Count - BytesRead > 0) then begin
6833 Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
6834 inc(CachePos, Count - BytesRead);
6837 //if no buffer overflow just read the data
6838 Move(PByteArray(Cache)^[CachePos], Buffer, Count);
6839 inc(CachePos, Count);
6843 procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
6848 inc(aBuffer, Counter.X.dir);
6851 PWord(aBuffer)^ := PWord(aData)^;
6852 inc(aBuffer, 2 * Counter.X.dir);
6855 PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
6856 PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
6857 PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
6858 inc(aBuffer, 3 * Counter.X.dir);
6861 PCardinal(aBuffer)^ := PCardinal(aData)^;
6862 inc(aBuffer, 4 * Counter.X.dir);
6868 TotalPixelsToRead, TotalPixelsRead: Integer;
6870 buf: array [0..3] of Byte; //1 pixel is max 32bit long
6871 PixelRepeat: Boolean;
6872 PixelsToRead, PixelCount: Integer;
6877 TotalPixelsToRead := Header.Width * Header.Height;
6878 TotalPixelsRead := 0;
6879 LinePixelsRead := 0;
6881 GetMem(Cache, CACHE_SIZE);
6883 TmpData := ImageData + Counter.Y.low * LineSize; //set line
6884 if (Counter.X.dir < 0) then //if x flipped then
6885 TmpData := TmpData + LineSize - PixelSize; //set last pixel
6889 CachedRead(Temp, 1);
6890 PixelRepeat := (Temp and $80) > 0;
6891 PixelsToRead := (Temp and $7F) + 1;
6892 inc(TotalPixelsRead, PixelsToRead);
6895 CachedRead(buf[0], PixelSize);
6896 while (PixelsToRead > 0) do begin
6898 PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
6899 while (PixelCount > 0) do begin
6900 if not PixelRepeat then
6901 CachedRead(buf[0], PixelSize);
6902 PixelToBuffer(@buf[0], TmpData);
6903 inc(LinePixelsRead);
6908 until (TotalPixelsRead >= TotalPixelsToRead);
6914 function IsGrayFormat: Boolean;
6916 result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
6922 // reading header to test file and set cursor back to begin
6923 StartPosition := aStream.Position;
6924 aStream.Read(Header{%H-}, SizeOf(Header));
6926 // no colormapped files
6927 if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
6928 TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
6931 if Header.ImageID <> 0 then // skip image ID
6932 aStream.Position := aStream.Position + Header.ImageID;
6935 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
6936 0: tgaFormat := tfLuminance8;
6937 8: tgaFormat := tfAlpha8;
6940 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
6941 0: tgaFormat := tfLuminance16;
6942 8: tgaFormat := tfLuminance8Alpha8;
6943 end else case (Header.ImageDesc and $F) of
6944 0: tgaFormat := tfBGR5;
6945 1: tgaFormat := tfBGR5A1;
6946 4: tgaFormat := tfBGRA4;
6949 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6950 0: tgaFormat := tfBGR8;
6953 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
6954 2: tgaFormat := tfBGR10A2;
6955 8: tgaFormat := tfBGRA8;
6959 if (tgaFormat = tfEmpty) then
6960 raise EglBitmapException.Create('LoadTga - unsupported format');
6962 FormatDesc := TFormatDescriptor.Get(tgaFormat);
6963 PixelSize := FormatDesc.GetSize(1, 1);
6964 LineSize := FormatDesc.GetSize(Header.Width, 1);
6966 GetMem(ImageData, LineSize * Header.Height);
6969 if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
6970 Counter.X.low := Header.Height-1;;
6971 Counter.X.high := 0;
6972 Counter.X.dir := -1;
6975 Counter.X.high := Header.Height-1;
6980 if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
6982 Counter.Y.high := Header.Height-1;
6985 Counter.Y.low := Header.Height-1;;
6986 Counter.Y.high := 0;
6987 Counter.Y.dir := -1;
6991 case Header.ImageType of
6992 TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
6994 TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
6998 SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
7005 aStream.Position := StartPosition;
7008 else aStream.Position := StartPosition;
7011 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7012 procedure TglBitmap.SaveTGA(const aStream: TStream);
7015 LineSize, Size, x, y: Integer;
7016 Pixel: TglBitmapPixelData;
7017 LineBuf, SourceData, DestData: PByte;
7018 SourceMD, DestMD: Pointer;
7019 FormatDesc: TFormatDescriptor;
7020 Converter: TFormatDescriptor;
7022 if not (ftTGA in FormatGetSupportedFiles(Format)) then
7023 raise EglBitmapUnsupportedFormat.Create('SaveTGA');
7026 FillChar(Header{%H-}, SizeOf(Header), 0);
7029 if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
7030 tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
7031 Header.ImageType := TGA_UNCOMPRESSED_GRAY
7033 Header.ImageType := TGA_UNCOMPRESSED_RGB;
7036 if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
7038 else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
7039 tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
7041 else if (Format in [tfBGR8, tfRGB8]) then
7049 Header.ImageDesc := 1 and $F;
7050 tfRGB10A2, tfBGR10A2:
7051 Header.ImageDesc := 2 and $F;
7053 Header.ImageDesc := 4 and $F;
7054 tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
7055 Header.ImageDesc := 8 and $F;
7058 Header.Width := Width;
7059 Header.Height := Height;
7060 Header.ImageDesc := Header.ImageDesc or $20; //flip y
7061 aStream.Write(Header, SizeOf(Header));
7063 // convert RGB(A) to BGR(A)
7065 FormatDesc := TFormatDescriptor.Get(Format);
7066 Size := FormatDesc.GetSize(Dimension);
7067 if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
7068 if (FormatDesc.RGBInverted = tfEmpty) then
7069 raise EglBitmapException.Create('inverted RGB format is empty');
7070 Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
7071 if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
7072 (Converter.PixelSize <> FormatDesc.PixelSize) then
7073 raise EglBitmapException.Create('invalid inverted RGB format');
7076 if Assigned(Converter) then begin
7077 LineSize := FormatDesc.GetSize(Width, 1);
7078 LineBuf := GetMem(LineSize);
7079 SourceMD := FormatDesc.CreateMappingData;
7080 DestMD := Converter.CreateMappingData;
7083 for y := 0 to Height-1 do begin
7084 DestData := LineBuf;
7085 for x := 0 to Width-1 do begin
7086 FormatDesc.Unmap(SourceData, Pixel, SourceMD);
7087 Converter.Map(Pixel, DestData, DestMD);
7089 aStream.Write(LineBuf^, LineSize);
7093 FormatDesc.FreeMappingData(SourceMD);
7094 FormatDesc.FreeMappingData(DestMD);
7097 aStream.Write(Data^, Size);
7100 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7101 //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7102 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7104 DDS_MAGIC: Cardinal = $20534444;
7106 // DDS_header.dwFlags
7107 DDSD_CAPS = $00000001;
7108 DDSD_HEIGHT = $00000002;
7109 DDSD_WIDTH = $00000004;
7110 DDSD_PIXELFORMAT = $00001000;
7112 // DDS_header.sPixelFormat.dwFlags
7113 DDPF_ALPHAPIXELS = $00000001;
7114 DDPF_ALPHA = $00000002;
7115 DDPF_FOURCC = $00000004;
7116 DDPF_RGB = $00000040;
7117 DDPF_LUMINANCE = $00020000;
7119 // DDS_header.sCaps.dwCaps1
7120 DDSCAPS_TEXTURE = $00001000;
7122 // DDS_header.sCaps.dwCaps2
7123 DDSCAPS2_CUBEMAP = $00000200;
7125 D3DFMT_DXT1 = $31545844;
7126 D3DFMT_DXT3 = $33545844;
7127 D3DFMT_DXT5 = $35545844;
7130 TDDSPixelFormat = packed record
7134 dwRGBBitCount: Cardinal;
7135 dwRBitMask: Cardinal;
7136 dwGBitMask: Cardinal;
7137 dwBBitMask: Cardinal;
7138 dwABitMask: Cardinal;
7141 TDDSCaps = packed record
7145 dwReserved: Cardinal;
7148 TDDSHeader = packed record
7153 dwPitchOrLinearSize: Cardinal;
7155 dwMipMapCount: Cardinal;
7156 dwReserved: array[0..10] of Cardinal;
7157 PixelFormat: TDDSPixelFormat;
7159 dwReserved2: Cardinal;
7162 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7163 function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
7166 Converter: TbmpBitfieldFormat;
7168 function GetDDSFormat: TglBitmapFormat;
7170 fd: TFormatDescriptor;
7172 Range: TglBitmapColorRec;
7176 with Header.PixelFormat do begin
7178 if ((dwFlags and DDPF_FOURCC) > 0) then begin
7179 case Header.PixelFormat.dwFourCC of
7180 D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
7181 D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
7182 D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
7184 end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
7186 //find matching format
7187 for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7188 fd := TFormatDescriptor.Get(result);
7189 if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
7190 (8 * fd.PixelSize = dwRGBBitCount) then
7194 //find format with same Range
7195 Range.r := dwRBitMask;
7196 Range.g := dwGBitMask;
7197 Range.b := dwBBitMask;
7198 Range.a := dwABitMask;
7199 for i := 0 to 3 do begin
7200 while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
7201 Range.arr[i] := Range.arr[i] shr 1;
7203 for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
7204 fd := TFormatDescriptor.Get(result);
7207 if (fd.Range.arr[i] <> Range.arr[i]) then begin
7215 //no format with same range found -> use default
7216 if (result = tfEmpty) then begin
7217 if (dwABitMask > 0) then
7223 Converter := TbmpBitfieldFormat.Create;
7224 Converter.RedMask := dwRBitMask;
7225 Converter.GreenMask := dwGBitMask;
7226 Converter.BlueMask := dwBBitMask;
7227 Converter.AlphaMask := dwABitMask;
7228 Converter.PixelSize := dwRGBBitCount / 8;
7235 x, y, LineSize, RowSize, Magic: Cardinal;
7236 NewImage, TmpData, RowData, SrcData: System.PByte;
7237 SourceMD, DestMD: Pointer;
7238 Pixel: TglBitmapPixelData;
7239 ddsFormat: TglBitmapFormat;
7240 FormatDesc: TFormatDescriptor;
7245 StreamPos := aStream.Position;
7248 aStream.Read(Magic{%H-}, sizeof(Magic));
7249 if (Magic <> DDS_MAGIC) then begin
7250 aStream.Position := StreamPos;
7255 aStream.Read(Header{%H-}, sizeof(Header));
7256 if (Header.dwSize <> SizeOf(Header)) or
7257 ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
7258 (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
7260 aStream.Position := StreamPos;
7264 if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
7265 raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
7267 ddsFormat := GetDDSFormat;
7269 if (ddsFormat = tfEmpty) then
7270 raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7272 FormatDesc := TFormatDescriptor.Get(ddsFormat);
7273 LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
7274 GetMem(NewImage, Header.dwHeight * LineSize);
7276 TmpData := NewImage;
7279 if Assigned(Converter) then begin
7280 RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
7281 GetMem(RowData, RowSize);
7282 SourceMD := Converter.CreateMappingData;
7283 DestMD := FormatDesc.CreateMappingData;
7285 for y := 0 to Header.dwHeight-1 do begin
7286 TmpData := NewImage + y * LineSize;
7288 aStream.Read(SrcData^, RowSize);
7289 for x := 0 to Header.dwWidth-1 do begin
7290 Converter.Unmap(SrcData, Pixel, SourceMD);
7291 glBitmapConvertPixel(Pixel, Converter, FormatDesc);
7292 FormatDesc.Map(Pixel, TmpData, DestMD);
7296 Converter.FreeMappingData(SourceMD);
7297 FormatDesc.FreeMappingData(DestMD);
7303 if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
7304 RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
7305 for Y := 0 to Header.dwHeight-1 do begin
7306 aStream.Read(TmpData^, RowSize);
7307 Inc(TmpData, LineSize);
7312 if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
7313 RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
7314 for Y := 0 to Header.dwHeight-1 do begin
7315 aStream.Read(TmpData^, RowSize);
7316 Inc(TmpData, LineSize);
7319 raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
7321 SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
7328 FreeAndNil(Converter);
7332 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7333 procedure TglBitmap.SaveDDS(const aStream: TStream);
7336 FormatDesc: TFormatDescriptor;
7338 if not (ftDDS in FormatGetSupportedFiles(Format)) then
7339 raise EglBitmapUnsupportedFormat.Create('SaveDDS');
7341 FormatDesc := TFormatDescriptor.Get(Format);
7344 FillChar(Header{%H-}, SizeOf(Header), 0);
7345 Header.dwSize := SizeOf(Header);
7346 Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
7348 Header.dwWidth := Max(1, Width);
7349 Header.dwHeight := Max(1, Height);
7352 Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
7355 Header.PixelFormat.dwSize := sizeof(Header);
7356 if (FormatDesc.IsCompressed) then begin
7357 Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
7359 tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
7360 tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
7361 tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
7363 end else if (Format in [tfAlpha8, tfAlpha16]) then begin
7364 Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
7365 Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7366 Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
7367 end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
7368 Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
7369 Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7370 Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
7371 Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
7373 Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
7374 Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
7375 Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
7376 Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
7377 Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
7378 Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
7381 if (FormatDesc.HasAlpha) then
7382 Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
7384 aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
7385 aStream.Write(Header, SizeOf(Header));
7386 aStream.Write(Data^, FormatDesc.GetSize(Dimension));
7389 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7390 //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7391 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7392 function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
7394 if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
7395 result := fLines[aIndex]
7400 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7401 procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
7402 const aWidth: Integer; const aHeight: Integer);
7404 Idx, LineWidth: Integer;
7406 inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
7408 if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
7410 fGetPixelFunc := GetPixel2DUnmap;
7411 fSetPixelFunc := SetPixel2DUnmap;
7414 if Assigned(Data) then begin
7415 SetLength(fLines, GetHeight);
7416 LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
7418 for Idx := 0 to GetHeight -1 do begin
7419 fLines[Idx] := Data;
7420 Inc(fLines[Idx], Idx * LineWidth);
7423 else SetLength(fLines, 0);
7425 SetLength(fLines, 0);
7427 fSetPixelFunc := nil;
7431 fGetPixelFunc := GetPixel2DDXT1;
7433 fGetPixelFunc := GetPixel2DDXT3;
7435 fGetPixelFunc := GetPixel2DDXT5;
7437 fGetPixelFunc := nil;
7443 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7444 procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
7446 FormatDesc: TFormatDescriptor;
7448 glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
7450 FormatDesc := TFormatDescriptor.Get(Format);
7451 if FormatDesc.IsCompressed then begin
7452 glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
7453 end else if aBuildWithGlu then begin
7454 gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
7455 FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
7457 glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
7458 FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
7462 if (FreeDataAfterGenTexture) then
7466 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7467 procedure TglBitmap2D.AfterConstruction;
7470 Target := GL_TEXTURE_2D;
7473 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7474 procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
7477 Size, w, h: Integer;
7478 FormatDesc: TFormatDescriptor;
7480 FormatDesc := TFormatDescriptor.Get(Format);
7481 if FormatDesc.IsCompressed then
7482 raise EglBitmapUnsupportedFormat.Create('TglBitmap2D.GrabScreen');
7484 w := aRight - aLeft;
7485 h := aBottom - aTop;
7486 Size := FormatDesc.GetSize(w, h);
7489 glPixelStorei(GL_PACK_ALIGNMENT, 1);
7490 glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
7491 SetDataPointer(Temp, Format, w, h);
7499 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7500 procedure TglBitmap2D.GetDataFromTexture;
7503 TempWidth, TempHeight: Integer;
7504 TempIntFormat: Cardinal;
7505 IntFormat, f: TglBitmapFormat;
7506 FormatDesc: TFormatDescriptor;
7511 glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
7512 glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
7513 glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
7515 IntFormat := tfEmpty;
7516 for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
7517 FormatDesc := TFormatDescriptor.Get(f);
7518 if (FormatDesc.glInternalFormat = TempIntFormat) then begin
7519 IntFormat := FormatDesc.Format;
7524 // Getting data from OpenGL
7525 FormatDesc := TFormatDescriptor.Get(IntFormat);
7526 GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
7528 if FormatDesc.IsCompressed then
7529 glGetCompressedTexImage(Target, 0, Temp)
7531 glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
7532 SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
7539 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7540 procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
7542 BuildWithGlu, PotTex, TexRec: Boolean;
7545 if Assigned(Data) then begin
7546 // Check Texture Size
7547 if (aTestTextureSize) then begin
7548 glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7550 if ((Height > TexSize) or (Width > TexSize)) then
7551 raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7553 PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
7554 TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
7556 if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7557 raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7561 SetupParameters(BuildWithGlu);
7562 UploadData(Target, BuildWithGlu);
7563 glAreTexturesResident(1, @fID, @fIsResident);
7567 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7568 function TglBitmap2D.FlipHorz: Boolean;
7571 TempDestData, DestData, SourceData: PByte;
7574 result := inherited FlipHorz;
7575 if Assigned(Data) then begin
7577 ImgSize := Height * fRowSize;
7578 GetMem(DestData, ImgSize);
7580 TempDestData := DestData;
7581 Dec(TempDestData, fRowSize + fPixelSize);
7582 for Row := 0 to Height -1 do begin
7583 Inc(TempDestData, fRowSize * 2);
7584 for Col := 0 to Width -1 do begin
7585 Move(SourceData^, TempDestData^, fPixelSize);
7586 Inc(SourceData, fPixelSize);
7587 Dec(TempDestData, fPixelSize);
7590 SetDataPointer(DestData, Format);
7599 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7600 function TglBitmap2D.FlipVert: Boolean;
7603 TempDestData, DestData, SourceData: PByte;
7605 result := inherited FlipVert;
7606 if Assigned(Data) then begin
7608 GetMem(DestData, Height * fRowSize);
7610 TempDestData := DestData;
7611 Inc(TempDestData, Width * (Height -1) * fPixelSize);
7612 for Row := 0 to Height -1 do begin
7613 Move(SourceData^, TempDestData^, fRowSize);
7614 Dec(TempDestData, fRowSize);
7615 Inc(SourceData, fRowSize);
7617 SetDataPointer(DestData, Format);
7626 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7627 //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7628 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7630 TMatrixItem = record
7635 PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
7636 TglBitmapToNormalMapRec = Record
7638 Heights: array of Single;
7639 MatrixU : array of TMatrixItem;
7640 MatrixV : array of TMatrixItem;
7644 ONE_OVER_255 = 1 / 255;
7646 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7647 procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
7651 with FuncRec do begin
7653 Source.Data.r * LUMINANCE_WEIGHT_R +
7654 Source.Data.g * LUMINANCE_WEIGHT_G +
7655 Source.Data.b * LUMINANCE_WEIGHT_B;
7656 PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
7660 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7661 procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
7664 PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
7667 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7668 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
7670 TVec = Array[0..2] of Single;
7677 function GetHeight(X, Y: Integer): Single;
7679 with FuncRec do begin
7680 X := Max(0, Min(Size.X -1, X));
7681 Y := Max(0, Min(Size.Y -1, Y));
7682 result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
7687 with FuncRec do begin
7688 with PglBitmapToNormalMapRec(Args)^ do begin
7690 for Idx := Low(MatrixU) to High(MatrixU) do
7691 du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
7694 for Idx := Low(MatrixU) to High(MatrixU) do
7695 dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
7697 Vec[0] := -du * Scale;
7698 Vec[1] := -dv * Scale;
7703 Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
7704 if Len <> 0 then begin
7705 Vec[0] := Vec[0] * Len;
7706 Vec[1] := Vec[1] * Len;
7707 Vec[2] := Vec[2] * Len;
7711 Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
7712 Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
7713 Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
7717 //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
7718 procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
7720 Rec: TglBitmapToNormalMapRec;
7722 procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
7724 if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
7725 Matrix[Index].X := X;
7726 Matrix[Index].Y := Y;
7727 Matrix[Index].W := W;
7733 if not FormatIsUncompressed(InternalFormat) then
7734 raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_FORMAT);
7737 if aScale > 100 then
7739 else if aScale < -100 then
7742 Rec.Scale := aScale;
7744 SetLength(Rec.Heights, Width * Height);
7748 SetLength(Rec.MatrixU, 2);
7749 SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
7750 SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
7752 SetLength(Rec.MatrixV, 2);
7753 SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
7754 SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
7758 SetLength(Rec.MatrixU, 6);
7759 SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
7760 SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
7761 SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
7762 SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
7763 SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
7764 SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
7766 SetLength(Rec.MatrixV, 6);
7767 SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
7768 SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
7769 SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
7770 SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
7771 SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
7772 SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
7776 SetLength(Rec.MatrixU, 6);
7777 SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
7778 SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
7779 SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
7780 SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
7781 SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
7782 SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
7784 SetLength(Rec.MatrixV, 6);
7785 SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
7786 SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
7787 SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
7788 SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
7789 SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
7790 SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
7794 SetLength(Rec.MatrixU, 20);
7795 SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
7796 SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
7797 SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
7798 SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
7799 SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
7800 SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
7801 SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
7802 SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
7803 SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
7804 SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
7805 SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
7806 SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
7807 SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
7808 SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
7809 SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
7810 SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
7811 SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
7812 SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
7813 SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
7814 SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
7816 SetLength(Rec.MatrixV, 20);
7817 SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
7818 SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
7819 SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
7820 SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
7821 SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
7822 SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
7823 SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
7824 SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
7825 SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
7826 SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
7827 SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
7828 SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
7829 SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
7830 SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
7831 SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
7832 SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
7833 SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
7834 SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
7835 SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
7836 SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
7841 if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
7842 AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
7844 AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
7845 AddFunc(glBitmapToNormalMapFunc, false, @Rec);
7847 SetLength(Rec.Heights, 0);
7860 procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
7865 if Height > 1 then begin
7866 // extract first line of the data
7867 Size := FormatGetImageSize(glBitmapPosition(Width), Format);
7868 GetMem(pTemp, Size);
7870 Move(Data^, pTemp^, Size);
7877 inherited SetDataPointer(pTemp, Format, Width);
7879 if FormatIsUncompressed(Format) then begin
7880 fUnmapFunc := FormatGetUnMapFunc(Format);
7881 fGetPixelFunc := GetPixel1DUnmap;
7886 procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
7891 Inc(pTemp, Pos.X * fPixelSize);
7893 fUnmapFunc(pTemp, Pixel);
7897 function TglBitmap1D.FlipHorz: Boolean;
7900 pTempDest, pDest, pSource: pByte;
7902 result := inherited FlipHorz;
7904 if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
7907 GetMem(pDest, fRowSize);
7911 Inc(pTempDest, fRowSize);
7912 for Col := 0 to Width -1 do begin
7913 Move(pSource^, pTempDest^, fPixelSize);
7915 Inc(pSource, fPixelSize);
7916 Dec(pTempDest, fPixelSize);
7919 SetDataPointer(pDest, InternalFormat);
7929 procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
7932 if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
7933 glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
7937 if BuildWithGlu then
7938 gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
7940 glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
7943 if (FreeDataAfterGenTexture) then
7948 procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
7950 BuildWithGlu, TexRec: Boolean;
7951 glFormat, glInternalFormat, glType: Cardinal;
7954 if Assigned(Data) then begin
7955 // Check Texture Size
7956 if (TestTextureSize) then begin
7957 glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
7959 if (Width > TexSize) then
7960 raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
7962 TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
7963 (Target = GL_TEXTURE_RECTANGLE_ARB);
7965 if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
7966 raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
7971 SetupParameters(BuildWithGlu);
7972 SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
7974 UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
7977 glAreTexturesResident(1, @fID, @fIsResident);
7982 procedure TglBitmap1D.AfterConstruction;
7986 Target := GL_TEXTURE_1D;
7990 { TglBitmapCubeMap }
7992 procedure TglBitmapCubeMap.AfterConstruction;
7996 if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
7997 raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
7999 SetWrap; // set all to GL_CLAMP_TO_EDGE
8000 Target := GL_TEXTURE_CUBE_MAP;
8001 fGenMode := GL_REFLECTION_MAP;
8005 procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
8007 inherited Bind (EnableTextureUnit);
8009 if EnableTexCoordsGen then begin
8010 glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
8011 glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
8012 glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
8013 glEnable(GL_TEXTURE_GEN_S);
8014 glEnable(GL_TEXTURE_GEN_T);
8015 glEnable(GL_TEXTURE_GEN_R);
8020 procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
8022 glFormat, glInternalFormat, glType: Cardinal;
8023 BuildWithGlu: Boolean;
8026 // Check Texture Size
8027 if (TestTextureSize) then begin
8028 glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
8030 if ((Height > TexSize) or (Width > TexSize)) then
8031 raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
8033 if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
8034 raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
8038 if ID = 0 then begin
8040 SetupParameters(BuildWithGlu);
8043 SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
8045 UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
8049 procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
8051 Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
8055 procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
8056 DisableTextureUnit: Boolean);
8058 inherited Unbind (DisableTextureUnit);
8060 if DisableTexCoordsGen then begin
8061 glDisable(GL_TEXTURE_GEN_S);
8062 glDisable(GL_TEXTURE_GEN_T);
8063 glDisable(GL_TEXTURE_GEN_R);
8068 { TglBitmapNormalMap }
8071 TVec = Array[0..2] of Single;
8072 TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8074 PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
8075 TglBitmapNormalMapRec = record
8077 Func: TglBitmapNormalMapGetVectorFunc;
8081 procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8084 Vec[1] := - (Position.Y + 0.5 - HalfSize);
8085 Vec[2] := - (Position.X + 0.5 - HalfSize);
8089 procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8091 Vec[0] := - HalfSize;
8092 Vec[1] := - (Position.Y + 0.5 - HalfSize);
8093 Vec[2] := Position.X + 0.5 - HalfSize;
8097 procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8099 Vec[0] := Position.X + 0.5 - HalfSize;
8101 Vec[2] := Position.Y + 0.5 - HalfSize;
8105 procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8107 Vec[0] := Position.X + 0.5 - HalfSize;
8108 Vec[1] := - HalfSize;
8109 Vec[2] := - (Position.Y + 0.5 - HalfSize);
8113 procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8115 Vec[0] := Position.X + 0.5 - HalfSize;
8116 Vec[1] := - (Position.Y + 0.5 - HalfSize);
8121 procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
8123 Vec[0] := - (Position.X + 0.5 - HalfSize);
8124 Vec[1] := - (Position.Y + 0.5 - HalfSize);
8125 Vec[2] := - HalfSize;
8129 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
8134 with FuncRec do begin
8135 with PglBitmapNormalMapRec (CustomData)^ do begin
8136 Func(Vec, Position, HalfSize);
8139 Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
8140 if Len <> 0 then begin
8141 Vec[0] := Vec[0] * Len;
8142 Vec[1] := Vec[1] * Len;
8143 Vec[2] := Vec[2] * Len;
8146 // Scale Vector and AddVectro
8147 Vec[0] := Vec[0] * 0.5 + 0.5;
8148 Vec[1] := Vec[1] * 0.5 + 0.5;
8149 Vec[2] := Vec[2] * 0.5 + 0.5;
8153 Dest.Red := Round(Vec[0] * 255);
8154 Dest.Green := Round(Vec[1] * 255);
8155 Dest.Blue := Round(Vec[2] * 255);
8160 procedure TglBitmapNormalMap.AfterConstruction;
8164 fGenMode := GL_NORMAL_MAP;
8168 procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
8169 TestTextureSize: Boolean);
8171 Rec: TglBitmapNormalMapRec;
8172 SizeRec: TglBitmapPixelPosition;
8174 Rec.HalfSize := Size div 2;
8176 FreeDataAfterGenTexture := false;
8178 SizeRec.Fields := [ffX, ffY];
8183 Rec.Func := glBitmapNormalMapPosX;
8184 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8185 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
8188 Rec.Func := glBitmapNormalMapNegX;
8189 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8190 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
8193 Rec.Func := glBitmapNormalMapPosY;
8194 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8195 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
8198 Rec.Func := glBitmapNormalMapNegY;
8199 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8200 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
8203 Rec.Func := glBitmapNormalMapPosZ;
8204 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8205 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
8208 Rec.Func := glBitmapNormalMapNegZ;
8209 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
8210 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
8215 glBitmapSetDefaultFormat(tfEmpty);
8216 glBitmapSetDefaultMipmap(mmMipmap);
8217 glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
8218 glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
8220 glBitmapSetDefaultFreeDataAfterGenTexture(true);
8221 glBitmapSetDefaultDeleteTextureOnFree (true);
8223 TFormatDescriptor.Init;
8225 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8226 OpenGLInitialized := false;
8227 InitOpenGLCS := TCriticalSection.Create;
8231 TFormatDescriptor.Finalize;
8233 {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
8234 FreeAndNil(InitOpenGLCS);