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.
222 // ###### Start of preferences ################################################
224 {.$define GLB_NO_NATIVE_GL}
225 // To enable the dglOpenGL.pas Header
226 // With native GL then bindings are staticlly declared to support other headers
227 // or use the glBitmap inside of DLLs (minimize codesize).
231 // To enable the support for SDL_surfaces
233 {.$define GLB_DELPHI}
234 // To enable the support for TBitmap from Delphi (not lazarus)
237 // *** image libs ***
239 {.$define GLB_SDL_IMAGE}
240 // To enable the support of SDL_image to load files. (READ ONLY)
241 // If you enable SDL_image all other libraries will be ignored!
244 {.$define GLB_PNGIMAGE}
245 // to enable png support with the unit pngimage. You can download it from http://pngdelphi.sourceforge.net/
246 // if you enable pngimage the libPNG will be ignored
248 {.$define GLB_LIB_PNG}
249 // to use the libPNG http://www.libpng.org/
250 // You will need an aditional header.
251 // http://www.opengl24.de/index.php?cat=header&file=libpng
253 {.$define GLB_DELPHI_JPEG}
254 // if you enable delphi jpegs the libJPEG will be ignored
256 {.$define GLB_LIB_JPEG}
257 // to use the libJPEG http://www.ijg.org/
258 // You will need an aditional header.
259 // http://www.opengl24.de/index.php?cat=header&file=libjpeg
261 // ###### End of preferences ##################################################
264 // ###### PRIVATE. Do not change anything. ####################################
265 // *** old defines for compatibility ***
266 {$ifdef NO_NATIVE_GL}
267 {$define GLB_NO_NATIVE_GL}
270 {$definde GLB_PNGIMAGE}
274 // *** Delphi Versions ***
288 // *** checking define combinations ***
289 {$ifdef GLB_SDL_IMAGE}
291 {$message warn 'SDL_image won''t work without SDL. SDL will be activated.'}
294 {$ifdef GLB_PNGIMAGE}
295 {$message warn 'The unit pngimage will be ignored because you are using SDL_image.'}
296 {$undef GLB_PNGIMAGE}
298 {$ifdef GLB_DELPHI_JPEG}
299 {$message warn 'The unit JPEG will be ignored because you are using SDL_image.'}
300 {$undef GLB_DELPHI_JPEG}
303 {$message warn 'The library libPNG will be ignored because you are using SDL_image.'}
306 {$ifdef GLB_LIB_JPEG}
307 {$message warn 'The library libJPEG will be ignored because you are using SDL_image.'}
308 {$undef GLB_LIB_JPEG}
311 {$define GLB_SUPPORT_PNG_READ}
312 {$define GLB_SUPPORT_JPEG_READ}
315 {$ifdef GLB_PNGIMAGE}
317 {$message warn 'The library libPNG will be ignored if you are using pngimage.'}
321 {$define GLB_SUPPORT_PNG_READ}
322 {$define GLB_SUPPORT_PNG_WRITE}
326 {$define GLB_SUPPORT_PNG_READ}
327 {$define GLB_SUPPORT_PNG_WRITE}
331 {$ifdef GLB_DELPHI_JPEG}
332 {$ifdef GLB_LIB_JPEG}
333 {$message warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
334 {$undef GLB_LIB_JPEG}
337 {$define GLB_SUPPORT_JPEG_READ}
338 {$define GLB_SUPPORT_JPEG_WRITE}
341 {$ifdef GLB_LIB_JPEG}
342 {$define GLB_SUPPORT_JPEG_READ}
343 {$define GLB_SUPPORT_JPEG_WRITE}
346 // *** general options ***
359 {$ifdef GLB_NO_NATIVE_GL} dglOpenGL, {$endif}
361 {$ifdef GLB_SDL} SDL, {$endif}
362 {$ifdef GLB_DELPHI} Dialogs, Windows, Graphics, {$endif}
364 {$ifdef GLB_SDL_IMAGE} SDL_image, {$endif}
366 {$ifdef GLB_PNGIMAGE} pngimage, {$endif}
367 {$ifdef GLB_LIB_PNG} libPNG, {$endif}
369 {$ifdef GLB_DELPHI_JPEG} JPEG, {$endif}
370 {$ifdef GLB_LIB_JPEG} libJPEG, {$endif}
381 TRGBQuad = packed record
390 {$ifndef GLB_NO_NATIVE_GL}
391 // Native OpenGL Implementation
393 PByteBool = ^ByteBool;
403 GL_EXTENSIONS = $1F03;
408 GL_TEXTURE_1D = $0DE0;
409 GL_TEXTURE_2D = $0DE1;
411 GL_MAX_TEXTURE_SIZE = $0D33;
412 GL_PACK_ALIGNMENT = $0D05;
413 GL_UNPACK_ALIGNMENT = $0CF5;
426 GL_LUMINANCE4 = $803F;
427 GL_LUMINANCE8 = $8040;
428 GL_LUMINANCE4_ALPHA4 = $8043;
429 GL_LUMINANCE8_ALPHA8 = $8045;
430 GL_DEPTH_COMPONENT = $1902;
432 GL_UNSIGNED_BYTE = $1401;
434 GL_LUMINANCE = $1909;
435 GL_LUMINANCE_ALPHA = $190A;
437 GL_TEXTURE_WIDTH = $1000;
438 GL_TEXTURE_HEIGHT = $1001;
439 GL_TEXTURE_INTERNAL_FORMAT = $1003;
440 GL_TEXTURE_RED_SIZE = $805C;
441 GL_TEXTURE_GREEN_SIZE = $805D;
442 GL_TEXTURE_BLUE_SIZE = $805E;
443 GL_TEXTURE_ALPHA_SIZE = $805F;
444 GL_TEXTURE_LUMINANCE_SIZE = $8060;
447 GL_UNSIGNED_SHORT_5_6_5 = $8363;
448 GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
449 GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
450 GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
451 GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
456 GL_NEAREST_MIPMAP_NEAREST = $2700;
457 GL_LINEAR_MIPMAP_NEAREST = $2701;
458 GL_NEAREST_MIPMAP_LINEAR = $2702;
459 GL_LINEAR_MIPMAP_LINEAR = $2703;
460 GL_TEXTURE_MAG_FILTER = $2800;
461 GL_TEXTURE_MIN_FILTER = $2801;
464 GL_TEXTURE_WRAP_S = $2802;
465 GL_TEXTURE_WRAP_T = $2803;
468 GL_CLAMP_TO_EDGE = $812F;
469 GL_CLAMP_TO_BORDER = $812D;
470 GL_TEXTURE_WRAP_R = $8072;
472 GL_MIRRORED_REPEAT = $8370;
475 GL_TEXTURE_BORDER_COLOR = $1004;
478 GL_NORMAL_MAP = $8511;
479 GL_REFLECTION_MAP = $8512;
483 GL_TEXTURE_GEN_MODE = $2500;
484 GL_TEXTURE_GEN_S = $0C60;
485 GL_TEXTURE_GEN_T = $0C61;
486 GL_TEXTURE_GEN_R = $0C62;
489 GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
490 GL_TEXTURE_CUBE_MAP = $8513;
491 GL_TEXTURE_BINDING_CUBE_MAP = $8514;
492 GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
493 GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
494 GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
495 GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
496 GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
497 GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
499 GL_TEXTURE_RECTANGLE_ARB = $84F5;
501 // GL_SGIS_generate_mipmap
502 GL_GENERATE_MIPMAP = $8191;
504 // GL_EXT_texture_compression_s3tc
505 GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
506 GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
507 GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
508 GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
510 // GL_EXT_texture_filter_anisotropic
511 GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
512 GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
514 // GL_ARB_texture_compression
515 GL_COMPRESSED_RGB = $84ED;
516 GL_COMPRESSED_RGBA = $84EE;
517 GL_COMPRESSED_ALPHA = $84E9;
518 GL_COMPRESSED_LUMINANCE = $84EA;
519 GL_COMPRESSED_LUMINANCE_ALPHA = $84EB;
528 GL_ARB_texture_border_clamp,
529 GL_ARB_texture_cube_map,
530 GL_ARB_texture_compression,
531 GL_ARB_texture_non_power_of_two,
532 GL_ARB_texture_rectangle,
533 GL_ARB_texture_mirrored_repeat,
535 GL_EXT_texture_edge_clamp,
536 GL_EXT_texture_cube_map,
537 GL_EXT_texture_compression_s3tc,
538 GL_EXT_texture_filter_anisotropic,
539 GL_EXT_texture_rectangle,
540 GL_NV_texture_rectangle,
541 GL_IBM_texture_mirrored_repeat,
542 GL_SGIS_generate_mipmap: Boolean;
548 libglu = 'libGLU.so.1';
549 libopengl = 'libGL.so.1';
551 libglu = 'glu32.dll';
552 libopengl = 'opengl32.dll';
557 function glXGetProcAddress(ProcName: PAnsiChar): Pointer; cdecl; external libopengl;
559 function wglGetProcAddress(ProcName: PAnsiChar): Pointer; stdcall; external libopengl;
562 function glGetString(name: Cardinal): PAnsiChar; {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
564 procedure glEnable(cap: Cardinal); {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
565 procedure glDisable(cap: Cardinal); {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
566 procedure glGetIntegerv(pname: Cardinal; params: PInteger); {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
568 procedure glTexImage1D(target: Cardinal; level, internalformat, width, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
569 procedure glTexImage2D(target: Cardinal; level, internalformat, width, height, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
571 procedure glGenTextures(n: Integer; Textures: PCardinal); {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
572 procedure glBindTexture(target: Cardinal; Texture: Cardinal); {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
573 procedure glDeleteTextures(n: Integer; const textures: PCardinal); {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
575 procedure glReadPixels(x, y: Integer; width, height: Integer; format, atype: Cardinal; pixels: Pointer); {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
576 procedure glPixelStorei(pname: Cardinal; param: Integer); {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
577 procedure glGetTexImage(target: Cardinal; level: Integer; format: Cardinal; _type: Cardinal; pixels: Pointer); {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
579 function glAreTexturesResident(n: Integer; const Textures: PCardinal; residences: PByteBool): ByteBool; {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
580 procedure glTexParameteri(target: Cardinal; pname: Cardinal; param: Integer); {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
581 procedure glTexParameterfv(target: Cardinal; pname: Cardinal; const params: PSingle); {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
582 procedure glGetTexLevelParameteriv(target: Cardinal; level: Integer; pname: Cardinal; params: PInteger); {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
583 procedure glTexGeni(coord, pname: Cardinal; param: Integer); {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libopengl;
585 function gluBuild1DMipmaps(Target: Cardinal; Components, Width: Integer; Format, atype: Cardinal; Data: Pointer): Integer; {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libglu;
586 function gluBuild2DMipmaps(Target: Cardinal; Components, Width, Height: Integer; Format, aType: Cardinal; Data: Pointer): Integer; {$ifdef Win32}stdcall; {$else}cdecl; {$endif} external libglu;
589 glCompressedTexImage2D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width, height: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$ifdef Win32}stdcall; {$else}cdecl; {$endif}
590 glCompressedTexImage1D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$ifdef Win32}stdcall; {$else}cdecl; {$endif}
591 glGetCompressedTexImage : procedure(target: Cardinal; level: Integer; img: Pointer); {$ifdef Win32}stdcall; {$else}cdecl; {$endif}
597 EglBitmapException = Exception;
598 EglBitmapSizeToLargeException = EglBitmapException;
599 EglBitmapNonPowerOfTwoException = EglBitmapException;
600 EglBitmapUnsupportedInternalFormat = EglBitmapException;
603 TglBitmapPixelDesc = packed record
606 GreenRange: Cardinal;
607 GreenShift: Shortint;
610 AlphaRange: Cardinal;
611 AlphaShift: Shortint;
614 TglBitmapPixelData = packed record
620 PixelDesc: TglBitmapPixelDesc;
623 TglBitmapPixelPositionFields = set of (ffX, ffY);
624 TglBitmapPixelPosition = record
625 Fields : TglBitmapPixelPositionFields;
631 cNullSize : TglBitmapPixelPosition = (Fields : []; X: 0; Y: 0);
636 TglBitmapFunctionRec = record
638 Size: TglBitmapPixelPosition;
639 Position: TglBitmapPixelPosition;
640 Source: TglBitmapPixelData;
641 Dest: TglBitmapPixelData;
645 TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
647 TglBitmapGetPixel = procedure (
648 const Pos: TglBitmapPixelPosition;
649 var Pixel: TglBitmapPixelData) of object;
651 TglBitmapSetPixel = procedure (
652 const Pos: TglBitmapPixelPosition;
653 const Pixel: TglBitmapPixelData) of object;
656 TglBitmapFileType = (
657 {$ifdef GLB_SUPPORT_PNG_WRITE} ftPNG, {$endif}
658 {$ifdef GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$endif}
662 TglBitmapFileTypes = set of TglBitmapFileType;
664 TglBitmapFormat = (tfDefault, tf4BitsPerChanel, tf8BitsPerChanel, tfCompressed);
665 TglBitmapMipMap = (mmNone, mmMipmap, mmMipmapGlu);
666 TglBitmapNormalMapFunc = (nm4Samples, nmSobel, nm3x3, nm5x5);
667 TglBitmapInternalFormat = (
692 TglBitmapMapFunc = procedure (const Pixel: TglBitmapPixelData; var pDest: pByte);
693 TglBitmapUnMapFunc = procedure (var pData: pByte; var Pixel: TglBitmapPixelData);
700 fFormat: TglBitmapFormat;
701 fMipMap: TglBitmapMipMap;
702 fAnisotropic: Integer;
703 fBorderColor: array [0..3] of single;
705 fDeleteTextureOnFree: Boolean;
706 fFreeDataAfterGenTexture: Boolean;
710 fInternalFormat: TglBitmapInternalFormat;
711 fDimension: TglBitmapPixelPosition;
713 fIsResident: Boolean;
718 fUnmapFunc: TglBitmapUnMapFunc;
719 fMapFunc: TglBitmapMapFunc;
730 fGetPixelFunc: TglBitmapGetPixel;
731 fSetPixelFunc: TglBitmapSetPixel;
736 fCustomNameW: WideString;
737 fCustomDataPointer: Pointer;
740 procedure SetDataPointer(NewData: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); virtual;
742 {$ifdef GLB_SUPPORT_PNG_READ}
743 function LoadPNG(Stream: TStream): Boolean; virtual;
745 {$ifdef GLB_SUPPORT_JPEG_READ}
746 function LoadJPEG(Stream: TStream): Boolean; virtual;
748 function LoadDDS(Stream: TStream): Boolean; virtual;
749 function LoadTGA(Stream: TStream): Boolean; virtual;
750 function LoadBMP(Stream: TStream): Boolean; virtual;
753 {$ifdef GLB_SUPPORT_PNG_WRITE}
754 procedure SavePNG(Stream: TStream); virtual;
756 {$ifdef GLB_SUPPORT_JPEG_WRITE}
757 procedure SaveJPEG(Stream: TStream); virtual;
759 procedure SaveDDS(Stream: TStream); virtual;
760 procedure SaveTGA(Stream: TStream); virtual;
761 procedure SaveBMP(Stream: TStream); virtual;
765 procedure SetupParameters(var BuildWithGlu: Boolean);
766 procedure SelectFormat(DataFormat: TglBitmapInternalFormat; var glFormat, glInternalFormat, glType: Cardinal; CanConvertImage: Boolean = True);
768 procedure GenTexture(TestTextureSize: Boolean = True); virtual; abstract;
770 procedure SetAnisotropic(const Value: Integer);
771 procedure SetInternalFormat(const Value: TglBitmapInternalFormat);
773 function FlipHorz: Boolean; virtual;
774 function FlipVert: Boolean; virtual;
776 function GetHeight: Integer;
777 function GetWidth: Integer;
779 function GetFileHeight: Integer;
780 function GetFileWidth: Integer;
782 property Width: Integer read GetWidth;
783 property Height: Integer read GetHeight;
785 property FileWidth: Integer read GetFileWidth;
786 property FileHeight: Integer read GetFileHeight;
789 property ID: Cardinal read fID write fID;
790 property Target: Cardinal read fTarget write fTarget;
791 property Format: TglBitmapFormat read fFormat write fFormat;
792 property InternalFormat: TglBitmapInternalFormat read fInternalFormat write SetInternalFormat;
793 property Dimension: TglBitmapPixelPosition read fDimension;
795 property Data: pByte read fData;
797 property MipMap: TglBitmapMipMap read fMipMap write fMipMap;
798 property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
800 property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write fDeleteTextureOnFree;
801 property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write fFreeDataAfterGenTexture;
803 property IsResident: boolean read fIsResident;
805 // propertys for custom data
806 property Filename: String read fFilename;
807 property CustomName: String read fCustomName write fCustomName;
808 property CustomNameW: WideString read fCustomNameW write fCustomNameW;
809 property CustomDataPointer: Pointer read fCustomDataPointer write fCustomDataPointer;
811 // Construction and Destructions Methods
812 procedure AfterConstruction; override;
813 procedure BeforeDestruction; override;
815 constructor Create(); overload;
816 constructor Create(FileName: String); overload;
817 constructor Create(Stream: TStream); overload;
819 constructor CreateFromResourceName(Instance: Cardinal; Resource: String; ResType: PChar = nil);
820 constructor Create(Instance: Cardinal; Resource: String; ResType: PChar = nil); overload;
821 constructor Create(Instance: Cardinal; ResourceID: Integer; ResType: PChar); overload;
823 constructor Create(Size: TglBitmapPixelPosition; Format: TglBitmapInternalFormat); overload;
824 constructor Create(Size: TglBitmapPixelPosition; Format: TglBitmapInternalFormat; Func: TglBitmapFunction; CustomData: Pointer = nil); overload;
826 function Clone: TglBitmap;
831 procedure LoadFromFile(FileName: String);
832 procedure LoadFromStream(Stream: TStream); virtual;
834 procedure LoadFromResource(Instance: Cardinal; Resource: String; ResType: PChar = nil);
835 procedure LoadFromResourceID(Instance: Cardinal; ResourceID: Integer; ResType: PChar);
837 procedure LoadFromFunc(Size: TglBitmapPixelPosition; Func: TglBitmapFunction; Format: TglBitmapInternalFormat; CustomData: Pointer = nil);
839 procedure SaveToFile(FileName: String; FileType: TglBitmapFileType);
840 procedure SaveToStream(Stream: TStream; FileType: TglBitmapFileType); virtual;
842 function AddFunc(Source: TglBitmap; Func: TglBitmapFunction; CreateTemp: Boolean; Format: TglBitmapInternalFormat; CustomData: Pointer = nil): boolean; overload;
843 function AddFunc(Func: TglBitmapFunction; CreateTemp: Boolean; CustomData: Pointer = nil): boolean; overload;
846 function AssignToSurface(out Surface: PSDL_Surface): boolean;
847 function AssignFromSurface(const Surface: PSDL_Surface): boolean;
848 function AssignAlphaToSurface(out Surface: PSDL_Surface): boolean;
850 function AddAlphaFromSurface(Surface: PSDL_Surface; Func: TglBitmapFunction = nil; CustomData: Pointer = nil): boolean;
853 function AssignToBitmap(const Bitmap: TBitmap): boolean;
854 function AssignFromBitmap(const Bitmap: TBitmap): boolean;
855 function AssignAlphaToBitmap(const Bitmap: TBitmap): boolean;
857 function AddAlphaFromBitmap(Bitmap: TBitmap; Func: TglBitmapFunction = nil; CustomData: Pointer = nil): boolean;
860 function AddAlphaFromFunc(Func: TglBitmapFunction; CustomData: Pointer = nil): boolean; virtual;
861 function AddAlphaFromFile(FileName: String; Func: TglBitmapFunction = nil; CustomData: Pointer = nil): boolean;
862 function AddAlphaFromStream(Stream: TStream; Func: TglBitmapFunction = nil; CustomData: Pointer = nil): boolean;
864 function AddAlphaFromResource(Instance: Cardinal; Resource: String; ResType: PChar = nil; Func: TglBitmapFunction = nil; CustomData: Pointer = nil): boolean;
865 function AddAlphaFromResourceID(Instance: Cardinal; ResourceID: Integer; ResType: PChar; Func: TglBitmapFunction = nil; CustomData: Pointer = nil): boolean;
867 function AddAlphaFromglBitmap(glBitmap: TglBitmap; Func: TglBitmapFunction = nil; CustomData: Pointer = nil): boolean;
869 function AddAlphaFromColorKey(Red, Green, Blue: Byte; Deviation: Byte = 0): Boolean;
870 function AddAlphaFromColorKeyRange(Red, Green, Blue: Cardinal; Deviation: Cardinal = 0): Boolean;
871 function AddAlphaFromColorKeyFloat(Red, Green, Blue: Single; Deviation: Single = 0): Boolean;
873 function AddAlphaFromValue(Alpha: Byte): Boolean;
874 function AddAlphaFromValueRange(Alpha: Cardinal): Boolean;
875 function AddAlphaFromValueFloat(Alpha: Single): Boolean;
877 function RemoveAlpha: Boolean; virtual;
879 function ConvertTo(NewFormat: TglBitmapInternalFormat): boolean; virtual;
882 procedure FillWithColor(Red, Green, Blue: Byte; Alpha : Byte = 255);
883 procedure FillWithColorRange(Red, Green, Blue: Cardinal; Alpha : Cardinal = $FFFFFFFF);
884 procedure FillWithColorFloat(Red, Green, Blue: Single; Alpha : Single = 1);
886 procedure Invert(UseRGB: Boolean = true; UseAlpha: Boolean = false);
888 procedure SetFilter(Min, Mag : Integer);
889 procedure SetWrap(S: Integer = GL_CLAMP_TO_EDGE;
890 T: Integer = GL_CLAMP_TO_EDGE; R: Integer = GL_CLAMP_TO_EDGE);
892 procedure SetBorderColor(Red, Green, Blue, Alpha: Single);
894 procedure GetPixel (const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData); virtual;
895 procedure SetPixel (const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData); virtual;
898 procedure Unbind(DisableTextureUnit: Boolean = True); virtual;
899 procedure Bind(EnableTextureUnit: Boolean = True); virtual;
903 TglBitmap2D = class(TglBitmap)
906 fLines: array of PByte;
908 procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
909 procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
910 procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
911 procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
912 procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
914 procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
916 function GetScanline(Index: Integer): Pointer;
918 procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
919 procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
925 property Scanline[Index: Integer]: Pointer read GetScanline;
927 procedure AfterConstruction; override;
929 procedure GrabScreen(Top, Left, Right, Bottom: Integer; Format: TglBitmapInternalFormat);
930 procedure GetDataFromTexture;
933 function FlipHorz: Boolean; override;
934 function FlipVert: Boolean; override;
936 procedure ToNormalMap(Func: TglBitmapNormalMapFunc = nm3x3; Scale: Single = 2; UseAlpha: Boolean = False);
939 procedure GenTexture(TestTextureSize: Boolean = True); override;
943 TglBitmapCubeMap = class(TglBitmap2D)
948 procedure GenTexture(TestTextureSize: Boolean = True); reintroduce;
950 procedure AfterConstruction; override;
952 procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
954 procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = True); reintroduce; virtual;
955 procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = True); reintroduce; virtual;
959 TglBitmapNormalMap = class(TglBitmapCubeMap)
961 procedure AfterConstruction; override;
963 procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
967 TglBitmap1D = class(TglBitmap)
969 procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
971 procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
972 procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
977 procedure AfterConstruction; override;
980 function FlipHorz: Boolean; override;
983 procedure GenTexture(TestTextureSize: Boolean = True); override;
987 // methods and vars for Defaults
988 procedure glBitmapSetDefaultFormat(Format: TglBitmapFormat);
989 procedure glBitmapSetDefaultFilter(Min, Mag: Integer);
990 procedure glBitmapSetDefaultWrap(S: Integer = GL_CLAMP_TO_EDGE; T: Integer = GL_CLAMP_TO_EDGE; R: Integer = GL_CLAMP_TO_EDGE);
992 procedure glBitmapSetDefaultDeleteTextureOnFree(DeleteTextureOnFree: Boolean);
993 procedure glBitmapSetDefaultFreeDataAfterGenTexture(FreeData: Boolean);
995 function glBitmapGetDefaultFormat: TglBitmapFormat;
996 procedure glBitmapGetDefaultFilter(var Min, Mag: Integer);
997 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Integer);
999 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
1000 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
1003 function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
1006 function FormatGetSize (Format: TglBitmapInternalFormat): Single;
1008 function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
1009 function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
1010 function FormatIsEmpty(Format: TglBitmapInternalFormat): boolean;
1011 function FormatHasAlpha(Format: TglBitmapInternalFormat): Boolean;
1013 procedure FormatPreparePixel(var Pixel: TglBitmapPixelData; Format: TglBitmapInternalFormat);
1015 function FormatGetWithoutAlpha(Format: TglBitmapInternalFormat): TglBitmapInternalFormat;
1016 function FormatGetWithAlpha(Format: TglBitmapInternalFormat): TglBitmapInternalFormat;
1018 function FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask: Cardinal; Format: TglBitmapInternalFormat): boolean;
1021 // Call LoadingMethods
1022 function LoadTexture(Filename: String; var Texture: Cardinal{$ifdef GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$endif}): Boolean;
1024 function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$ifdef GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$endif}): Boolean;
1026 function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
1030 glBitmapDefaultFormat: TglBitmapFormat;
1031 glBitmapDefaultFilterMin: Integer;
1032 glBitmapDefaultFilterMag: Integer;
1033 glBitmapDefaultWrapS: Integer;
1034 glBitmapDefaultWrapT: Integer;
1035 glBitmapDefaultWrapR: Integer;
1037 glBitmapDefaultDeleteTextureOnFree: Boolean;
1038 glBitmapDefaultFreeDataAfterGenTextures: Boolean;
1041 function CreateGrayPalette: HPALETTE;
1051 {$ifndef GLB_NO_NATIVE_GL}
1052 procedure ReadOpenGLExtensions;
1058 MajorVersion, MinorVersion: Integer;
1061 procedure TrimVersionString(Buffer: AnsiString; var Major, Minor: Integer);
1068 Separator := Pos(AnsiString('.'), Buffer);
1070 if (Separator > 1) and (Separator < Length(Buffer)) and
1071 (Buffer[Separator - 1] in ['0'..'9']) and
1072 (Buffer[Separator + 1] in ['0'..'9']) then begin
1075 while (Separator > 0) and (Buffer[Separator] in ['0'..'9']) do
1078 Delete(Buffer, 1, Separator);
1079 Separator := Pos(AnsiString('.'), Buffer) + 1;
1081 while (Separator <= Length(Buffer)) and (AnsiChar(Buffer[Separator]) in ['0'..'9']) do
1084 Delete(Buffer, Separator, 255);
1085 Separator := Pos(AnsiString('.'), Buffer);
1087 Major := StrToInt(Copy(String(Buffer), 1, Separator - 1));
1088 Minor := StrToInt(Copy(String(Buffer), Separator + 1, 1));
1093 function CheckExtension(const Extension: AnsiString): Boolean;
1097 ExtPos := Pos(Extension, Buffer);
1098 Result := ExtPos > 0;
1101 Result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
1105 function glLoad (aFunc: pAnsiChar): pointer;
1108 Result := glXGetProcAddress(aFunc);
1110 Result := wglGetProcAddress(aFunc);
1117 Context := wglGetCurrentContext;
1119 if Context <> gLastContext then begin
1120 gLastContext := Context;
1124 Buffer := glGetString(GL_VERSION);
1125 TrimVersionString(Buffer, MajorVersion, MinorVersion);
1127 GL_VERSION_1_2 := False;
1128 GL_VERSION_1_3 := False;
1129 GL_VERSION_1_4 := False;
1130 GL_VERSION_2_0 := False;
1132 if MajorVersion = 1 then begin
1133 if MinorVersion >= 1 then begin
1134 if MinorVersion >= 2 then
1135 GL_VERSION_1_2 := True;
1137 if MinorVersion >= 3 then
1138 GL_VERSION_1_3 := True;
1140 if MinorVersion >= 4 then
1141 GL_VERSION_1_4 := True;
1145 if MajorVersion >= 2 then begin
1146 GL_VERSION_1_2 := True;
1147 GL_VERSION_1_3 := True;
1148 GL_VERSION_1_4 := True;
1149 GL_VERSION_2_0 := True;
1153 Buffer := glGetString(GL_EXTENSIONS);
1154 GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
1155 GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
1156 GL_ARB_texture_compression := CheckExtension('GL_ARB_texture_compression');
1157 GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
1158 GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
1159 GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
1160 GL_EXT_bgra := CheckExtension('GL_EXT_bgra');
1161 GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
1162 GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
1163 GL_EXT_texture_compression_s3tc := CheckExtension('GL_EXT_texture_compression_s3tc');
1164 GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
1165 GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
1166 GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
1167 GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
1168 GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
1171 if GL_VERSION_1_3 then begin
1173 glCompressedTexImage1D := glLoad('glCompressedTexImage1D');
1174 glCompressedTexImage2D := glLoad('glCompressedTexImage2D');
1175 glGetCompressedTexImage := glLoad('glGetCompressedTexImage');
1179 // Try loading Extension
1180 glCompressedTexImage1D := glLoad('glCompressedTexImage1DARB');
1181 glCompressedTexImage2D := glLoad('glCompressedTexImage2DARB');
1182 glGetCompressedTexImage := glLoad('glGetCompressedTexImageARB');
1191 function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
1193 Result.Fields := [];
1196 Result.Fields := Result.Fields + [ffX];
1198 Result.Fields := Result.Fields + [ffY];
1200 Result.X := Max(0, X);
1201 Result.Y := Max(0, Y);
1206 UNSUPPORTED_INTERNAL_FORMAT = 'the given format isn''t supported by this function.';
1208 PIXEL_DESC_ALPHA : TglBitmapPixelDesc = (
1209 RedRange : $00; RedShift : 0;
1210 GreenRange : $00; GreenShift : 0;
1211 BlueRange : $00; BlueShift : 0;
1212 AlphaRange : $FF; AlphaShift : 0 );
1214 PIXEL_DESC_LUMINANCE : TglBitmapPixelDesc = (
1215 RedRange : $FF; RedShift : 0;
1216 GreenRange : $FF; GreenShift : 0;
1217 BlueRange : $FF; BlueShift : 0;
1218 AlphaRange : $00; AlphaShift : 0 );
1220 PIXEL_DESC_DEPTH8 : TglBitmapPixelDesc = (
1221 RedRange : $FF; RedShift : 0;
1222 GreenRange : $FF; GreenShift : 0;
1223 BlueRange : $FF; BlueShift : 0;
1224 AlphaRange : $00; AlphaShift : 0 );
1226 PIXEL_DESC_LUMINANCEALPHA : TglBitmapPixelDesc = (
1227 RedRange : $FF; RedShift : 0;
1228 GreenRange : $FF; GreenShift : 0;
1229 BlueRange : $FF; BlueShift : 0;
1230 AlphaRange : $FF; AlphaShift : 8 );
1232 PIXEL_DESC_RGBA4 : TglBitmapPixelDesc = (
1233 RedRange : $0F; RedShift : 8;
1234 GreenRange : $0F; GreenShift : 4;
1235 BlueRange : $0F; BlueShift : 0;
1236 AlphaRange : $0F; AlphaShift : 12 );
1238 PIXEL_DESC_R5G6B5 : TglBitmapPixelDesc = (
1239 RedRange : $1F; RedShift : 11;
1240 GreenRange : $3F; GreenShift : 5;
1241 BlueRange : $1F; BlueShift : 0;
1242 AlphaRange : $00; AlphaShift : 0 );
1244 PIXEL_DESC_RGB5A1 : TglBitmapPixelDesc = (
1245 RedRange : $1F; RedShift : 10;
1246 GreenRange : $1F; GreenShift : 5;
1247 BlueRange : $1F; BlueShift : 0;
1248 AlphaRange : $01; AlphaShift : 15 );
1250 PIXEL_DESC_RGB8 : TglBitmapPixelDesc = (
1251 RedRange : $FF; RedShift : 0;
1252 GreenRange : $FF; GreenShift : 8;
1253 BlueRange : $FF; BlueShift : 16;
1254 AlphaRange : $00; AlphaShift : 0 );
1256 PIXEL_DESC_RGBA8 : TglBitmapPixelDesc = (
1257 RedRange : $FF; RedShift : 0;
1258 GreenRange : $FF; GreenShift : 8;
1259 BlueRange : $FF; BlueShift : 16;
1260 AlphaRange : $FF; AlphaShift : 24 );
1262 PIXEL_DESC_BGR8 : TglBitmapPixelDesc = (
1263 RedRange : $FF; RedShift : 16;
1264 GreenRange : $FF; GreenShift : 8;
1265 BlueRange : $FF; BlueShift : 0;
1266 AlphaRange : $00; AlphaShift : 0 );
1268 PIXEL_DESC_BGRA8 : TglBitmapPixelDesc = (
1269 RedRange : $FF; RedShift : 16;
1270 GreenRange : $FF; GreenShift : 8;
1271 BlueRange : $FF; BlueShift : 0;
1272 AlphaRange : $FF; AlphaShift : 24 );
1274 PIXEL_DESC_RGB10A2 : TglBitmapPixelDesc = (
1275 RedRange : $3FF; RedShift : 20;
1276 GreenRange : $3FF; GreenShift : 10;
1277 BlueRange : $3FF; BlueShift : 0;
1278 AlphaRange : $003; AlphaShift : 30 );
1284 procedure MapAlpha(const Pixel: TglBitmapPixelData; var pDest: pByte);
1286 pDest^ := Pixel.Alpha;
1291 procedure MapLuminance(const Pixel: TglBitmapPixelData; var pDest: pByte);
1293 pDest^ := Trunc(Pixel.Red * 0.3 + Pixel.Green * 0.59 + Pixel.Blue * 0.11);
1298 procedure MapDepth8(const Pixel: TglBitmapPixelData; var pDest: pByte);
1300 pDest^ := (Pixel.Red + Pixel.Green + Pixel.Blue) div 3;
1305 procedure MapLuminanceAlpha(const Pixel: TglBitmapPixelData; var pDest: pByte);
1307 pDest^ := Trunc(Pixel.Red * 0.3 + Pixel.Green * 0.59 + Pixel.Blue * 0.11);
1310 pDest^ := Pixel.Alpha;
1315 procedure MapRGBA4(const Pixel: TglBitmapPixelData; var pDest: pByte);
1318 Pixel.Alpha shl PIXEL_DESC_RGBA4.AlphaShift or
1319 Pixel.Red shl PIXEL_DESC_RGBA4.RedShift or
1320 Pixel.Green shl PIXEL_DESC_RGBA4.GreenShift or
1327 procedure MapR5G6B5(const Pixel: TglBitmapPixelData; var pDest: pByte);
1330 Pixel.Red shl PIXEL_DESC_R5G6B5.RedShift or
1331 Pixel.Green shl PIXEL_DESC_R5G6B5.GreenShift or
1338 procedure MapRGB5A1(const Pixel: TglBitmapPixelData; var pDest: pByte);
1341 Pixel.Alpha shl PIXEL_DESC_RGB5A1.AlphaShift or
1342 Pixel.Red shl PIXEL_DESC_RGB5A1.RedShift or
1343 Pixel.Green shl PIXEL_DESC_RGB5A1.GreenShift or
1350 procedure MapRGB8(const Pixel: TglBitmapPixelData; var pDest: pByte);
1352 pDest^ := Pixel.Red;
1355 pDest^ := Pixel.Green;
1358 pDest^ := Pixel.Blue;
1363 procedure MapBGR8(const Pixel: TglBitmapPixelData; var pDest: pByte);
1365 pDest^ := Pixel.Blue;
1368 pDest^ := Pixel.Green;
1371 pDest^ := Pixel.Red;
1376 procedure MapRGBA8(const Pixel: TglBitmapPixelData; var pDest: pByte);
1379 Pixel.Alpha shl PIXEL_DESC_RGBA8.AlphaShift or
1380 Pixel.Blue shl PIXEL_DESC_RGBA8.BlueShift or
1381 Pixel.Green shl PIXEL_DESC_RGBA8.GreenShift or
1388 procedure MapBGRA8(const Pixel: TglBitmapPixelData; var pDest: pByte);
1391 Pixel.Alpha shl PIXEL_DESC_BGRA8.AlphaShift or
1392 Pixel.Red shl PIXEL_DESC_BGRA8.RedShift or
1393 Pixel.Green shl PIXEL_DESC_BGRA8.GreenShift or
1400 procedure MapRGB10A2(const Pixel: TglBitmapPixelData; var pDest: pByte);
1403 Pixel.Alpha shl PIXEL_DESC_RGB10A2.AlphaShift or
1404 Pixel.Red shl PIXEL_DESC_RGB10A2.RedShift or
1405 Pixel.Green shl PIXEL_DESC_RGB10A2.GreenShift or
1412 function FormatGetMapFunc(Format: TglBitmapInternalFormat): TglBitmapMapFunc;
1415 ifAlpha: Result := MapAlpha;
1416 ifLuminance: Result := MapLuminance;
1417 ifDepth8: Result := MapDepth8;
1418 ifLuminanceAlpha: Result := MapLuminanceAlpha;
1419 ifRGBA4: Result := MapRGBA4;
1420 ifR5G6B5: Result := MapR5G6B5;
1421 ifRGB5A1: Result := MapRGB5A1;
1422 ifRGB8: Result := MapRGB8;
1423 ifBGR8: Result := MapBGR8;
1424 ifRGBA8: Result := MapRGBA8;
1425 ifBGRA8: Result := MapBGRA8;
1426 ifRGB10A2: Result := MapRGB10A2;
1428 raise EglBitmapUnsupportedInternalFormat.Create('FormatGetMapFunc - ' + UNSUPPORTED_INTERNAL_FORMAT);
1436 procedure UnMapAlpha(var pData: pByte; var Pixel: TglBitmapPixelData);
1438 Pixel.Alpha := pData^;
1439 Pixel.Red := Pixel.PixelDesc.RedRange;
1440 Pixel.Green := Pixel.PixelDesc.GreenRange;
1441 Pixel.Blue := Pixel.PixelDesc.BlueRange;
1447 procedure UnMapLuminance(var pData: pByte; var Pixel: TglBitmapPixelData);
1450 Pixel.Red := pData^;
1451 Pixel.Green := pData^;
1452 Pixel.Blue := pData^;
1458 procedure UnMapDepth8(var pData: pByte; var Pixel: TglBitmapPixelData);
1461 Pixel.Red := pData^;
1462 Pixel.Green := pData^;
1463 Pixel.Blue := pData^;
1469 procedure UnMapLuminanceAlpha(var pData: pByte; var Pixel: TglBitmapPixelData);
1471 Pixel.Red := pData^;
1472 Pixel.Green := pData^;
1473 Pixel.Blue := pData^;
1476 Pixel.Alpha := pData^;
1481 procedure UnMapRGBA4(var pData: pByte; var Pixel: TglBitmapPixelData);
1485 Temp := pWord(pData)^;
1487 Pixel.Alpha := Temp shr PIXEL_DESC_RGBA4.AlphaShift and PIXEL_DESC_RGBA4.AlphaRange;
1488 Pixel.Red := Temp shr PIXEL_DESC_RGBA4.RedShift and PIXEL_DESC_RGBA4.RedRange;
1489 Pixel.Green := Temp shr PIXEL_DESC_RGBA4.GreenShift and PIXEL_DESC_RGBA4.GreenRange;
1490 Pixel.Blue := Temp and PIXEL_DESC_RGBA4.BlueRange;
1496 procedure UnMapR5G6B5(var pData: pByte; var Pixel: TglBitmapPixelData);
1500 Temp := pWord(pData)^;
1502 Pixel.Alpha := Pixel.PixelDesc.AlphaRange;
1503 Pixel.Red := Temp shr PIXEL_DESC_R5G6B5.RedShift and PIXEL_DESC_R5G6B5.RedRange;
1504 Pixel.Green := Temp shr PIXEL_DESC_R5G6B5.GreenShift and PIXEL_DESC_R5G6B5.GreenRange;
1505 Pixel.Blue := Temp and PIXEL_DESC_R5G6B5.BlueRange;
1511 procedure UnMapRGB5A1(var pData: pByte; var Pixel: TglBitmapPixelData);
1515 Temp := pWord(pData)^;
1517 Pixel.Alpha := Temp shr PIXEL_DESC_RGB5A1.AlphaShift and PIXEL_DESC_RGB5A1.AlphaRange;
1518 Pixel.Red := Temp shr PIXEL_DESC_RGB5A1.RedShift and PIXEL_DESC_RGB5A1.RedRange;
1519 Pixel.Green := Temp shr PIXEL_DESC_RGB5A1.GreenShift and PIXEL_DESC_RGB5A1.GreenRange;
1520 Pixel.Blue := Temp and PIXEL_DESC_RGB5A1.BlueRange;
1526 procedure UnMapRGB8(var pData: pByte; var Pixel: TglBitmapPixelData);
1528 Pixel.Alpha := Pixel.PixelDesc.AlphaRange;
1530 Pixel.Red := pData^;
1533 Pixel.Green := pData^;
1536 Pixel.Blue := pData^;
1541 procedure UnMapBGR8(var pData: pByte; var Pixel: TglBitmapPixelData);
1543 Pixel.Alpha := Pixel.PixelDesc.AlphaRange;
1545 Pixel.Blue := pData^;
1548 Pixel.Green := pData^;
1551 Pixel.Red := pData^;
1556 procedure UnMapRGBA8(var pData: pByte; var Pixel: TglBitmapPixelData);
1558 Pixel.Red := pData^;
1561 Pixel.Green := pData^;
1564 Pixel.Blue := pData^;
1567 Pixel.Alpha := pData^;
1572 procedure UnMapBGRA8(var pData: pByte; var Pixel: TglBitmapPixelData);
1574 Pixel.Blue := pData^;
1577 Pixel.Green := pData^;
1580 Pixel.Red := pData^;
1583 Pixel.Alpha := pData^;
1588 procedure UnMapRGB10A2(var pData: pByte; var Pixel: TglBitmapPixelData);
1592 Temp := pDWord(pData)^;
1594 Pixel.Alpha := Temp shr PIXEL_DESC_RGB10A2.AlphaShift and PIXEL_DESC_RGB10A2.AlphaRange;
1595 Pixel.Red := Temp shr PIXEL_DESC_RGB10A2.RedShift and PIXEL_DESC_RGB10A2.RedRange;
1596 Pixel.Green := Temp shr PIXEL_DESC_RGB10A2.GreenShift and PIXEL_DESC_RGB10A2.GreenRange;
1597 Pixel.Blue := Temp and PIXEL_DESC_RGB10A2.BlueRange;
1603 function FormatGetUnMapFunc(Format: TglBitmapInternalFormat): TglBitmapUnMapFunc;
1606 ifAlpha: Result := UnmapAlpha;
1607 ifLuminance: Result := UnMapLuminance;
1608 ifDepth8: Result := UnMapDepth8;
1609 ifLuminanceAlpha: Result := UnMapLuminanceAlpha;
1610 ifRGBA4: Result := UnMapRGBA4;
1611 ifR5G6B5: Result := UnMapR5G6B5;
1612 ifRGB5A1: Result := UnMapRGB5A1;
1613 ifRGB8: Result := UnMapRGB8;
1614 ifBGR8: Result := UnMapBGR8;
1615 ifRGBA8: Result := UnMapRGBA8;
1616 ifBGRA8: Result := UnMapBGRA8;
1617 ifRGB10A2: Result := UnMapRGB10A2;
1619 raise EglBitmapUnsupportedInternalFormat.Create('FormatGetUnMapFunc - ' + UNSUPPORTED_INTERNAL_FORMAT);
1626 function FormatGetSize (Format: TglBitmapInternalFormat): Single;
1633 ifAlpha, ifLuminance, ifDepth8, ifDXT3, ifDXT5:
1635 ifLuminanceAlpha, ifRGBA4, ifRGB5A1, ifR5G6B5:
1639 ifBGRA8, ifRGBA8, ifRGB10A2:
1642 raise EglBitmapUnsupportedInternalFormat.Create('FormatGetSize - ' + UNSUPPORTED_INTERNAL_FORMAT);
1647 function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
1649 Result := Format in [ifDXT1, ifDXT3, ifDXT5];
1653 function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
1655 Result := Format in [ifAlpha, ifLuminance, ifDepth8, ifLuminanceAlpha, ifRGBA4, ifRGB5A1, ifR5G6B5, ifBGR8, ifRGB8, ifBGRA8, ifRGBA8, ifRGB10A2];
1659 function FormatIsEmpty(Format: TglBitmapInternalFormat): boolean;
1661 Result := Format = ifEmpty;
1665 function FormatHasAlpha(Format: TglBitmapInternalFormat): Boolean;
1667 Result := Format in [ifDXT1, ifDXT3, ifDXT5 ,ifAlpha, ifLuminanceAlpha, ifRGBA4, ifRGB5A1, ifBGRA8, ifRGBA8, ifRGB10A2];
1671 procedure FormatPreparePixel(var Pixel: TglBitmapPixelData; Format: TglBitmapInternalFormat);
1673 FillChar(Pixel, SizeOf(Pixel), #0);
1677 Pixel.PixelDesc := PIXEL_DESC_ALPHA;
1679 Pixel.PixelDesc := PIXEL_DESC_LUMINANCE;
1681 Pixel.PixelDesc := PIXEL_DESC_DEPTH8;
1683 Pixel.PixelDesc := PIXEL_DESC_LUMINANCEALPHA;
1685 Pixel.PixelDesc := PIXEL_DESC_RGBA4;
1687 Pixel.PixelDesc := PIXEL_DESC_R5G6B5;
1689 Pixel.PixelDesc := PIXEL_DESC_RGB5A1;
1690 ifDXT1, ifDXT3, ifDXT5, ifBGRA8:
1691 Pixel.PixelDesc := PIXEL_DESC_BGRA8;
1693 Pixel.PixelDesc := PIXEL_DESC_BGR8;
1695 Pixel.PixelDesc := PIXEL_DESC_RGB8;
1697 Pixel.PixelDesc := PIXEL_DESC_RGBA8;
1699 Pixel.PixelDesc := PIXEL_DESC_RGB10A2;
1702 Pixel.Red := Pixel.PixelDesc.RedRange;
1703 Pixel.Green := Pixel.PixelDesc.GreenRange;
1704 Pixel.Blue := Pixel.PixelDesc.BlueRange;
1705 Pixel.Alpha := Pixel.PixelDesc.AlphaRange;
1709 function FormatGetWithoutAlpha(Format: TglBitmapInternalFormat): TglBitmapInternalFormat;
1713 Result := ifLuminance;
1715 Result := ifLuminance;
1732 function FormatGetWithAlpha(Format: TglBitmapInternalFormat): TglBitmapInternalFormat;
1736 Result := ifLuminanceAlpha;
1749 function FormatGetUncompressed(Format: TglBitmapInternalFormat): TglBitmapInternalFormat;
1764 function FormatGetImageSize(Size: TglBitmapPixelPosition; Format: TglBitmapInternalFormat): Integer;
1766 if (Size.X = 0) and (Size.Y = 0) then
1769 Result := Trunc(Max(Size.Y, 1) * Max(Size.X, 1) * FormatGetSize(Format));
1773 function FormatGetSupportedFiles(Format: TglBitmapInternalFormat): TglBitmapFileTypes;
1777 {$ifdef GLB_SUPPORT_PNG_WRITE}
1778 if Format in [ifLuminance, ifAlpha, ifDepth8, ifLuminanceAlpha, ifBGR8, ifBGRA8, ifRGB8, ifRGBA8] then
1779 Result := Result + [ftPNG];
1782 {$ifdef GLB_SUPPORT_JPEG_WRITE}
1783 if Format in [ifLuminance, ifAlpha, ifDepth8, ifRGB8, ifBGR8] then
1784 Result := Result + [ftJPEG];
1787 Result := Result + [ftDDS];
1789 if Format in [ifLuminance, ifAlpha, ifDepth8, ifLuminanceAlpha, ifBGR8, ifRGB8, ifBGRA8, ifRGBA8] then
1790 Result := Result + [ftTGA];
1792 if Format in [ifLuminance, ifAlpha, ifDepth8, ifLuminanceAlpha, ifRGBA4, ifRGB5A1, ifR5G6B5, ifRGB8, ifBGR8, ifRGBA8, ifBGRA8, ifRGB10A2] then
1793 Result := Result + [ftBMP];
1797 function FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask: Cardinal; Format: TglBitmapInternalFormat): boolean;
1799 Pix: TglBitmapPixelData;
1803 if (RedMask = 0) and (GreenMask = 0) and (BlueMask = 0) and (AlphaMask = 0) then
1804 raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
1806 FormatPreparePixel(Pix, Format);
1808 with Pix.PixelDesc do begin
1809 if RedMask <> 0 then
1810 if (RedMask <> (RedRange shl RedShift)) then
1813 if GreenMask <> 0 then
1814 if (GreenMask <> (GreenRange shl GreenShift)) then
1817 if BlueMask <> 0 then
1818 if (BlueMask <> (BlueRange shl BlueShift)) then
1821 if AlphaMask <> 0 then
1822 if (AlphaMask <> (AlphaRange shl AlphaShift)) then
1830 function IsPowerOfTwo(Number: Integer): Boolean;
1832 while Number and 1 = 0 do
1833 Number := Number shr 1;
1835 Result := Number = 1;
1839 function GetBitSize(BitSet: Cardinal): Integer;
1843 while BitSet > 0 do begin
1844 if (BitSet and $1) = 1 then
1847 BitSet := BitSet shr 1;
1852 procedure SwapRGB(pData: pByte; Width: Integer; HasAlpha: Boolean);
1855 TRGBPix = array [0..2] of byte;
1859 while Width > 0 do begin
1860 Temp := pRGBPIX(pData)^[0];
1861 pRGBPIX(pData)^[0] := pRGBPIX(pData)^[2];
1862 pRGBPIX(pData)^[2] := Temp;
1875 function CreateGrayPalette: HPALETTE;
1880 GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
1882 Pal.palVersion := $300;
1883 Pal.palNumEntries := 256;
1886 {$DEFINE GLB_TEMPRANGECHECK}
1890 for Idx := 0 to 256 - 1 do begin
1891 Pal.palPalEntry[Idx].peRed := Idx;
1892 Pal.palPalEntry[Idx].peGreen := Idx;
1893 Pal.palPalEntry[Idx].peBlue := Idx;
1894 Pal.palPalEntry[Idx].peFlags := 0;
1897 {$IFDEF GLB_TEMPRANGECHECK}
1898 {$UNDEF GLB_TEMPRANGECHECK}
1902 Result := CreatePalette(Pal^);
1909 {$ifdef GLB_SDL_IMAGE}
1910 function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
1912 Result := TStream(context^.unknown.data1).Seek(offset, whence);
1916 function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
1918 Result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
1922 function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
1924 Result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
1928 function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
1934 function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
1936 Result := SDL_AllocRW;
1938 if Result = nil then
1939 raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
1941 Result^.seek := glBitmapRWseek;
1942 Result^.read := glBitmapRWread;
1943 Result^.write := glBitmapRWwrite;
1944 Result^.close := glBitmapRWclose;
1945 Result^.unknown.data1 := Stream;
1953 function LoadTexture(Filename: String; var Texture: Cardinal{$ifdef GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$endif}): Boolean;
1955 glBitmap: TglBitmap2D;
1961 if Instance = 0 then
1962 Instance := HInstance;
1964 if (LoadFromRes) then
1965 glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
1968 glBitmap := TglBitmap2D.Create(FileName);
1971 glBitmap.DeleteTextureOnFree := False;
1972 glBitmap.FreeDataAfterGenTexture := False;
1973 glBitmap.GenTexture(True);
1974 if (glBitmap.ID > 0) then begin
1975 Texture := glBitmap.ID;
1984 function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$ifdef GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$endif}): Boolean;
1986 CM: TglBitmapCubeMap;
1991 if Instance = 0 then
1992 Instance := HInstance;
1995 CM := TglBitmapCubeMap.Create;
1997 CM.DeleteTextureOnFree := False;
2001 if (LoadFromRes) then
2002 CM.LoadFromResource(Instance, PositiveX)
2005 CM.LoadFromFile(PositiveX);
2006 CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
2009 if (LoadFromRes) then
2010 CM.LoadFromResource(Instance, NegativeX)
2013 CM.LoadFromFile(NegativeX);
2014 CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
2017 if (LoadFromRes) then
2018 CM.LoadFromResource(Instance, PositiveY)
2021 CM.LoadFromFile(PositiveY);
2022 CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
2025 if (LoadFromRes) then
2026 CM.LoadFromResource(Instance, NegativeY)
2029 CM.LoadFromFile(NegativeY);
2030 CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
2033 if (LoadFromRes) then
2034 CM.LoadFromResource(Instance, PositiveZ)
2037 CM.LoadFromFile(PositiveZ);
2038 CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
2041 if (LoadFromRes) then
2042 CM.LoadFromResource(Instance, NegativeZ)
2045 CM.LoadFromFile(NegativeZ);
2046 CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
2056 function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
2058 NM: TglBitmapNormalMap;
2062 NM := TglBitmapNormalMap.Create;
2064 NM.DeleteTextureOnFree := False;
2065 NM.GenerateNormalMap(Size);
2078 procedure glBitmapSetDefaultFormat(Format: TglBitmapFormat);
2080 glBitmapDefaultFormat := Format;
2084 procedure glBitmapSetDefaultDeleteTextureOnFree(DeleteTextureOnFree: Boolean);
2086 glBitmapDefaultDeleteTextureOnFree := DeleteTextureOnFree;
2090 procedure glBitmapSetDefaultFilter(Min, Mag: Integer);
2092 glBitmapDefaultFilterMin := Min;
2093 glBitmapDefaultFilterMag := Mag;
2097 procedure glBitmapSetDefaultWrap(S: Integer; T: Integer; R: Integer);
2099 glBitmapDefaultWrapS := S;
2100 glBitmapDefaultWrapT := T;
2101 glBitmapDefaultWrapR := R;
2105 procedure glBitmapSetDefaultFreeDataAfterGenTexture(FreeData: Boolean);
2107 glBitmapDefaultFreeDataAfterGenTextures := FreeData;
2111 function glBitmapGetDefaultFormat: TglBitmapFormat;
2113 Result := glBitmapDefaultFormat;
2117 function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
2119 Result := glBitmapDefaultDeleteTextureOnFree;
2123 procedure glBitmapGetDefaultFilter(var Min, Mag: Integer);
2125 Min := glBitmapDefaultFilterMin;
2126 Mag := glBitmapDefaultFilterMag;
2130 procedure glBitmapGetDefaultTextureWrap(var S, T, R: Integer);
2132 S := glBitmapDefaultWrapS;
2133 T := glBitmapDefaultWrapT;
2134 R := glBitmapDefaultWrapR;
2138 function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
2140 Result := glBitmapDefaultFreeDataAfterGenTextures;
2146 procedure TglBitmap.AfterConstruction;
2152 fMipMap := mmMipmap;
2153 fIsResident := False;
2156 fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
2157 fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
2159 fFormat := glBitmapGetDefaultFormat;
2161 glBitmapGetDefaultFilter(fFilterMin, fFilterMag);
2162 glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
2166 procedure TglBitmap.BeforeDestruction;
2168 SetDataPointer(nil, ifEmpty);
2170 if ((ID > 0) and (fDeleteTextureOnFree)) then
2171 glDeleteTextures(1, @ID);
2177 constructor TglBitmap.Create;
2179 {$ifndef GLB_NO_NATIVE_GL}
2180 ReadOpenGLExtensions;
2183 if (ClassType = TglBitmap) then
2184 raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
2190 constructor TglBitmap.Create(FileName: String);
2193 LoadFromFile(FileName);
2197 constructor TglBitmap.Create(Stream: TStream);
2200 LoadFromStream(Stream);
2205 constructor TglBitmap.CreateFromResourceName(Instance: Cardinal; Resource: String; ResType: PChar);
2208 LoadFromResource(Instance, Resource, ResType);
2212 constructor TglBitmap.Create(Instance: Cardinal; Resource: String; ResType: PChar);
2215 LoadFromResource(Instance, Resource, ResType);
2220 constructor TglBitmap.Create(Instance: Cardinal; ResourceID: Integer; ResType: PChar);
2223 LoadFromResourceID(Instance, ResourceID, ResType);
2228 constructor TglBitmap.Create(Size: TglBitmapPixelPosition;
2229 Format: TglBitmapInternalFormat);
2236 ImageSize := FormatGetImageSize(Size, Format);
2237 GetMem(Image, ImageSize);
2239 FillChar(Image^, ImageSize, #$FF);
2241 SetDataPointer(Image, Format, Size.X, Size.Y);
2249 constructor TglBitmap.Create(Size: TglBitmapPixelPosition;
2250 Format: TglBitmapInternalFormat; Func: TglBitmapFunction; CustomData: Pointer);
2253 LoadFromFunc(Size, Func, Format, CustomData);
2257 function TglBitmap.Clone: TglBitmap;
2263 Temp := ClassType.Create as TglBitmap;
2265 // copy texture data if assigned
2266 if Assigned(Data) then begin
2267 Size := FormatGetImageSize(glBitmapPosition(Width, Height), InternalFormat);
2269 GetMem(TempPtr, Size);
2271 Move(Data^, TempPtr^, Size);
2272 Temp.SetDataPointer(TempPtr, InternalFormat, Width, Height);
2278 Temp.SetDataPointer(nil, InternalFormat, Width, Height);
2282 Temp.fTarget := Target;
2283 Temp.fFormat := Format;
2284 Temp.fMipMap := MipMap;
2285 Temp.fAnisotropic := Anisotropic;
2286 Temp.fBorderColor := fBorderColor;
2287 Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
2288 Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
2289 Temp.fFilterMin := fFilterMin;
2290 Temp.fFilterMag := fFilterMag;
2291 Temp.fWrapS := fWrapS;
2292 Temp.fWrapT := fWrapT;
2293 Temp.fWrapR := fWrapR;
2294 Temp.fFilename := fFilename;
2295 Temp.fCustomName := fCustomName;
2296 Temp.fCustomNameW := fCustomNameW;
2297 Temp.fCustomDataPointer := fCustomDataPointer;
2307 procedure TglBitmap.LoadFromFile(FileName: String);
2311 fFilename := FileName;
2313 FS := TFileStream.Create(FileName, fmOpenRead);
2324 procedure TglBitmap.LoadFromStream(Stream: TStream);
2326 {$ifdef GLB_SUPPORT_PNG_READ}
2327 if not LoadPNG(Stream) then
2329 {$ifdef GLB_SUPPORT_JPEG_READ}
2330 if not LoadJPEG(Stream) then
2332 if not LoadDDS(Stream) then
2333 if not LoadTGA(Stream) then
2334 if not LoadBMP(Stream) then
2335 raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
2340 procedure TglBitmap.LoadFromResource(Instance: Cardinal; Resource: String; ResType: PChar);
2342 RS: TResourceStream;
2347 if Assigned(ResType) then
2348 TempResType := ResType
2351 TempPos := Pos('.', Resource);
2352 ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
2353 Resource := UpperCase(Copy(Resource, 0, TempPos -1));
2354 TempResType := PChar(ResTypeStr);
2357 RS := TResourceStream.Create(Instance, Resource, TempResType);
2366 procedure TglBitmap.LoadFromResourceID(Instance: Cardinal; ResourceID: Integer; ResType: PChar);
2368 RS: TResourceStream;
2370 RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
2381 procedure TglBitmap.LoadFromFunc(Size: TglBitmapPixelPosition;
2382 Func: TglBitmapFunction; Format: TglBitmapInternalFormat; CustomData: Pointer);
2387 ImageSize := FormatGetImageSize(Size, Format);
2388 GetMem(Image, ImageSize);
2390 FillChar(Image^, ImageSize, #$FF);
2392 SetDataPointer(Image, Format, Size.X, Size.Y);
2398 AddFunc(Self, Func, False, Format, CustomData)
2402 procedure TglBitmap.SaveToFile(FileName: String; FileType: TglBitmapFileType);
2406 FS := TFileStream.Create(FileName, fmCreate);
2409 SaveToStream(FS, FileType);
2416 procedure TglBitmap.SaveToStream(Stream: TStream; FileType: TglBitmapFileType);
2419 {$ifdef GLB_SUPPORT_PNG_WRITE}
2420 ftPNG: SavePng(Stream);
2422 {$ifdef GLB_SUPPORT_JPEG_WRITE}
2423 ftJPEG: SaveJPEG(Stream);
2425 ftDDS: SaveDDS(Stream);
2426 ftTGA: SaveTGA(Stream);
2427 ftBMP: SaveBMP(Stream);
2433 function TglBitmap.AssignToSurface(out Surface: PSDL_Surface): boolean;
2435 Row, RowSize: Integer;
2436 pSource, pData: PByte;
2438 Pix: TglBitmapPixelData;
2440 function GetRowPointer(Row: Integer): pByte;
2442 Result := Surface.pixels;
2443 Inc(Result, Row * RowSize);
2449 if not FormatIsUncompressed(InternalFormat) then
2450 raise EglBitmapUnsupportedInternalFormat.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
2452 if Assigned(Data) then begin
2453 case Trunc(FormatGetSize(InternalFormat)) of
2459 raise EglBitmapException.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
2462 FormatPreparePixel(Pix, InternalFormat);
2464 with Pix.PixelDesc do
2465 Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth, RedRange shl RedShift, GreenRange shl GreenShift, BlueRange shl BlueShift, AlphaRange shl AlphaShift);
2468 RowSize := Trunc(FileWidth * FormatGetSize(InternalFormat));
2470 for Row := 0 to FileHeight -1 do begin
2471 pData := GetRowPointer(Row);
2473 if Assigned(pData) then begin
2474 Move(pSource^, pData^, RowSize);
2475 Inc(pSource, RowSize);
2484 function TglBitmap.AssignFromSurface(const Surface: PSDL_Surface): boolean;
2486 pSource, pData, pTempData: PByte;
2487 Row, RowSize, TempWidth, TempHeight: Integer;
2488 IntFormat: TglBitmapInternalFormat;
2490 function GetRowPointer(Row: Integer): pByte;
2492 Result := Surface^.pixels;
2493 Inc(Result, Row * RowSize);
2499 if (Assigned(Surface)) then begin
2500 with Surface^.format^ do begin
2501 if FormatCheckFormat(RMask, GMask, BMask, AMask, ifLuminance) then
2502 IntFormat := ifLuminance
2505 if FormatCheckFormat(RMask, GMask, BMask, AMask, ifLuminanceAlpha) then
2506 IntFormat := ifLuminanceAlpha
2509 if FormatCheckFormat(RMask, GMask, BMask, AMask, ifRGBA4) then
2510 IntFormat := ifRGBA4
2513 if FormatCheckFormat(RMask, GMask, BMask, AMask, ifR5G6B5) then
2514 IntFormat := ifR5G6B5
2517 if FormatCheckFormat(RMask, GMask, BMask, AMask, ifRGB5A1) then
2518 IntFormat := ifRGB5A1
2521 if FormatCheckFormat(RMask, GMask, BMask, AMask, ifBGR8) then
2525 if FormatCheckFormat(RMask, GMask, BMask, AMask, ifRGB8) then
2529 if FormatCheckFormat(RMask, GMask, BMask, AMask, ifBGRA8) then
2530 IntFormat := ifBGRA8
2533 if FormatCheckFormat(RMask, GMask, BMask, AMask, ifRGBA8) then
2534 IntFormat := ifRGBA8
2537 if FormatCheckFormat(RMask, GMask, BMask, AMask, ifRGB10A2) then
2538 IntFormat := ifRGB10A2
2540 raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
2543 TempWidth := Surface^.w;
2544 TempHeight := Surface^.h;
2546 RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
2548 GetMem(pData, TempHeight * RowSize);
2552 for Row := 0 to TempHeight -1 do begin
2553 pSource := GetRowPointer(Row);
2555 if (Assigned(pSource)) then begin
2556 Move(pSource^, pTempData^, RowSize);
2557 Inc(pTempData, RowSize);
2561 SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
2572 function TglBitmap.AssignAlphaToSurface(out Surface: PSDL_Surface): boolean;
2574 Row, Col, AlphaInterleave: Integer;
2575 pSource, pDest: PByte;
2577 function GetRowPointer(Row: Integer): pByte;
2579 Result := Surface.pixels;
2580 Inc(Result, Row * Width);
2586 if Assigned(Data) then begin
2587 if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifBGRA8, ifRGBA8] then begin
2588 Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
2590 case InternalFormat of
2592 AlphaInterleave := 1;
2594 AlphaInterleave := 3;
2596 AlphaInterleave := 0;
2602 for Row := 0 to Height -1 do begin
2603 pDest := GetRowPointer(Row);
2605 if Assigned(pDest) then begin
2606 for Col := 0 to Width -1 do begin
2607 Inc(pSource, AlphaInterleave);
2621 function TglBitmap.AddAlphaFromSurface(Surface: PSDL_Surface; Func: TglBitmapFunction; CustomData: Pointer): boolean;
2623 glBitmap: TglBitmap2D;
2625 glBitmap := TglBitmap2D.Create;
2627 glBitmap.AssignFromSurface(Surface);
2629 Result := AddAlphaFromglBitmap(glBitmap, Func, CustomData);
2638 function TglBitmap.AssignFromBitmap(const Bitmap: TBitmap): boolean;
2640 pSource, pData, pTempData: PByte;
2641 Row, RowSize, TempWidth, TempHeight: Integer;
2642 IntFormat: TglBitmapInternalFormat;
2646 if (Assigned(Bitmap)) then begin
2647 case Bitmap.PixelFormat of
2649 IntFormat := ifLuminance;
2651 IntFormat := ifRGB5A1;
2653 IntFormat := ifR5G6B5;
2655 IntFormat := ifBGR8;
2657 IntFormat := ifBGRA8;
2659 raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
2662 TempWidth := Bitmap.Width;
2663 TempHeight := Bitmap.Height;
2665 RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
2667 GetMem(pData, TempHeight * RowSize);
2671 for Row := 0 to TempHeight -1 do begin
2672 pSource := Bitmap.Scanline[Row];
2674 if (Assigned(pSource)) then begin
2675 Move(pSource^, pTempData^, RowSize);
2676 Inc(pTempData, RowSize);
2680 SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
2691 function TglBitmap.AssignToBitmap(const Bitmap: TBitmap): boolean;
2694 pSource, pData: PByte;
2698 if Assigned(Data) then begin
2699 if Assigned(Bitmap) then begin
2700 Bitmap.Width := Width;
2701 Bitmap.Height := Height;
2703 case InternalFormat of
2704 ifAlpha, ifLuminance, ifDepth8:
2706 Bitmap.PixelFormat := pf8bit;
2707 Bitmap.Palette := CreateGrayPalette;
2710 Bitmap.PixelFormat := pf15bit;
2712 Bitmap.PixelFormat := pf16bit;
2714 Bitmap.PixelFormat := pf24bit;
2716 Bitmap.PixelFormat := pf32bit;
2718 raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
2722 for Row := 0 to FileHeight -1 do begin
2723 pData := Bitmap.Scanline[Row];
2725 Move(pSource^, pData^, fRowSize);
2726 Inc(pSource, fRowSize);
2728 // swap RGB(A) to BGR(A)
2729 if InternalFormat in [ifRGB8, ifRGBA8] then
2730 SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
2739 function TglBitmap.AssignAlphaToBitmap(const Bitmap: TBitmap): boolean;
2741 Row, Col, AlphaInterleave: Integer;
2742 pSource, pDest: PByte;
2746 if Assigned(Data) then begin
2747 if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
2748 if Assigned(Bitmap) then begin
2749 Bitmap.PixelFormat := pf8bit;
2750 Bitmap.Palette := CreateGrayPalette;
2751 Bitmap.Width := Width;
2752 Bitmap.Height := Height;
2754 case InternalFormat of
2756 AlphaInterleave := 1;
2758 AlphaInterleave := 3;
2760 AlphaInterleave := 0;
2766 for Row := 0 to Height -1 do begin
2767 pDest := Bitmap.Scanline[Row];
2769 if Assigned(pDest) then begin
2770 for Col := 0 to Width -1 do begin
2771 Inc(pSource, AlphaInterleave);
2786 function TglBitmap.AddAlphaFromBitmap(Bitmap: TBitmap; Func: TglBitmapFunction; CustomData: Pointer): boolean;
2788 glBitmap: TglBitmap2D;
2790 glBitmap := TglBitmap2D.Create;
2792 glBitmap.AssignFromBitmap(Bitmap);
2794 Result := AddAlphaFromglBitmap(glBitmap, Func, CustomData);
2802 function TglBitmap.AddAlphaFromFile(FileName: String; Func: TglBitmapFunction; CustomData: Pointer): boolean;
2806 FS := TFileStream.Create(FileName, fmOpenRead);
2808 Result := AddAlphaFromStream(FS, Func, CustomData);
2815 function TglBitmap.AddAlphaFromStream(Stream: TStream; Func: TglBitmapFunction; CustomData: Pointer): boolean;
2817 glBitmap: TglBitmap2D;
2819 glBitmap := TglBitmap2D.Create(Stream);
2821 Result := AddAlphaFromglBitmap(glBitmap, Func, CustomData);
2829 function TglBitmap.AddAlphaFromResource(Instance: Cardinal; Resource: String;
2830 ResType: PChar; Func: TglBitmapFunction; CustomData: Pointer): boolean;
2832 RS: TResourceStream;
2837 if Assigned(ResType) then
2838 TempResType := ResType
2841 TempPos := Pos('.', Resource);
2842 ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
2843 Resource := UpperCase(Copy(Resource, 0, TempPos -1));
2844 TempResType := PChar(ResTypeStr);
2847 RS := TResourceStream.Create(Instance, Resource, TempResType);
2849 Result := AddAlphaFromStream(RS, Func, CustomData);
2856 function TglBitmap.AddAlphaFromResourceID(Instance: Cardinal; ResourceID: Integer;
2857 ResType: PChar; Func: TglBitmapFunction; CustomData: Pointer): boolean;
2859 RS: TResourceStream;
2861 RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
2863 Result := AddAlphaFromStream(RS, Func, CustomData);
2871 procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
2873 with FuncRec do begin
2874 Dest.Red := Source.Red;
2875 Dest.Green := Source.Green;
2876 Dest.Blue := Source.Blue;
2878 with TglBitmapPixelData(CustomData^) do
2879 if ((Dest.Red <= Red ) and (Dest.Red >= PixelDesc.RedRange ) and
2880 (Dest.Green <= Green) and (Dest.Green >= PixelDesc.GreenRange) and
2881 (Dest.Blue <= Blue ) and (Dest.Blue >= PixelDesc.BlueRange )) then
2884 Dest.Alpha := Dest.PixelDesc.AlphaRange;
2889 function TglBitmap.AddAlphaFromColorKey(Red, Green, Blue, Deviation: Byte): Boolean;
2891 Result := AddAlphaFromColorKeyFloat(Red / $FF, Green / $FF, Blue / $FF, Deviation / $FF);
2895 function TglBitmap.AddAlphaFromColorKeyRange(Red, Green, Blue: Cardinal; Deviation: Cardinal = 0): Boolean;
2897 PixelData: TglBitmapPixelData;
2899 FormatPreparePixel(PixelData, FormatGetWithAlpha(InternalFormat));
2901 Result := AddAlphaFromColorKeyFloat(
2902 Red / PixelData.PixelDesc.RedRange,
2903 Green / PixelData.PixelDesc.GreenRange,
2904 Blue / PixelData.PixelDesc.BlueRange,
2905 Deviation / Max(PixelData.PixelDesc.RedRange, Max(PixelData.PixelDesc.GreenRange, PixelData.PixelDesc.BlueRange)));
2909 function TglBitmap.AddAlphaFromColorKeyFloat(Red, Green, Blue: Single; Deviation: Single = 0): Boolean;
2911 TempR, TempG, TempB: Cardinal;
2912 PixelData: TglBitmapPixelData;
2914 FormatPreparePixel(PixelData, FormatGetWithAlpha(InternalFormat));
2916 // Calculate Colorrange
2917 with PixelData.PixelDesc do begin
2918 TempR := Trunc(RedRange * Deviation);
2919 TempG := Trunc(GreenRange * Deviation);
2920 TempB := Trunc(BlueRange * Deviation);
2922 PixelData.Red := Min(RedRange, Trunc(RedRange * Red) + TempR);
2923 RedRange := Max(0, Trunc(RedRange * Red) - TempR);
2924 PixelData.Green := Min(GreenRange, Trunc(GreenRange * Green) + TempG);
2925 GreenRange := Max(0, Trunc(GreenRange * Green) - TempG);
2926 PixelData.Blue := Min(BlueRange, Trunc(BlueRange * Blue) + TempB);
2927 BlueRange := Max(0, Trunc(BlueRange * Blue) - TempB);
2928 PixelData.Alpha := 0;
2932 Result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
2936 procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
2938 with FuncRec do begin
2939 Dest.Red := Source.Red;
2940 Dest.Green := Source.Green;
2941 Dest.Blue := Source.Blue;
2943 with TglBitmapPixelData(CustomData^) do
2944 Dest.Alpha := Alpha;
2949 function TglBitmap.AddAlphaFromValue(Alpha: Byte): Boolean;
2951 Result := AddAlphaFromValueFloat(Alpha / $FF);
2955 function TglBitmap.AddAlphaFromValueFloat(Alpha: Single): Boolean;
2957 PixelData: TglBitmapPixelData;
2959 FormatPreparePixel(PixelData, FormatGetWithAlpha(InternalFormat));
2961 with PixelData.PixelDesc do
2962 PixelData.Alpha := Min(AlphaRange, Max(0, Round(AlphaRange * Alpha)));
2964 Result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData);
2968 function TglBitmap.AddAlphaFromValueRange(Alpha: Cardinal): Boolean;
2970 PixelData: TglBitmapPixelData;
2972 FormatPreparePixel(PixelData, FormatGetWithAlpha(InternalFormat));
2974 Result := AddAlphaFromValueFloat(Alpha / PixelData.PixelDesc.AlphaRange);
2978 procedure glBitmapInvertFunc(var FuncRec: TglBitmapFunctionRec);
2980 with FuncRec do begin
2981 Dest.Red := Source.Red;
2982 Dest.Green := Source.Green;
2983 Dest.Blue := Source.Blue;
2984 Dest.Alpha := Source.Alpha;
2986 if (Integer(CustomData) and $1 > 0) then begin
2987 Dest.Red := Dest.Red xor Dest.PixelDesc.RedRange;
2988 Dest.Green := Dest.Green xor Dest.PixelDesc.GreenRange;
2989 Dest.Blue := Dest.Blue xor Dest.PixelDesc.BlueRange;
2992 if (Integer(CustomData) and $2 > 0) then begin
2993 Dest.Alpha := Dest.Alpha xor Dest.PixelDesc.AlphaRange;
2999 procedure TglBitmap.Invert(UseRGB, UseAlpha: Boolean);
3001 if ((UseRGB) or (UseAlpha)) then
3002 AddFunc(glBitmapInvertFunc, False, Pointer(Integer(UseAlpha) shl 1 or Integer(UseRGB)));
3006 procedure TglBitmap.SetFilter(Min, Mag: Integer);
3010 fFilterMin := GL_NEAREST;
3012 fFilterMin := GL_LINEAR;
3013 GL_NEAREST_MIPMAP_NEAREST:
3014 fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
3015 GL_LINEAR_MIPMAP_NEAREST:
3016 fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
3017 GL_NEAREST_MIPMAP_LINEAR:
3018 fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
3019 GL_LINEAR_MIPMAP_LINEAR:
3020 fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
3022 raise EglBitmapException.Create('SetFilter - Unknow Minfilter.');
3027 fFilterMag := GL_NEAREST;
3029 fFilterMag := GL_LINEAR;
3031 raise EglBitmapException.Create('SetFilter - Unknow Magfilter.');
3034 // If texture is created then assign filter
3035 if ID > 0 then begin
3038 glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
3040 if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE_ARB) then begin
3042 GL_NEAREST, GL_LINEAR:
3043 glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
3044 GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
3045 glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
3046 GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
3047 glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
3050 glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
3055 procedure TglBitmap.SetWrap(S: Integer; T: Integer; R: Integer);
3061 fWrapS := GL_REPEAT;
3064 if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
3065 fWrapS := GL_CLAMP_TO_EDGE
3071 if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
3072 fWrapS := GL_CLAMP_TO_BORDER
3078 if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
3079 fWrapS := GL_MIRRORED_REPEAT
3081 raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
3084 raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
3091 fWrapT := GL_REPEAT;
3094 if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
3095 fWrapT := GL_CLAMP_TO_EDGE
3101 if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
3102 fWrapT := GL_CLAMP_TO_BORDER
3108 if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
3109 fWrapT := GL_MIRRORED_REPEAT
3111 raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (T).');
3114 raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (T).');
3121 fWrapR := GL_REPEAT;
3124 if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
3125 fWrapR := GL_CLAMP_TO_EDGE
3131 if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
3132 fWrapR := GL_CLAMP_TO_BORDER
3138 if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
3139 fWrapR := GL_MIRRORED_REPEAT
3141 raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (R).');
3144 raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (R).');
3147 if ID > 0 then begin
3149 glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
3150 glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
3151 glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
3156 procedure TglBitmap.SetDataPointer(NewData: PByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
3159 if Data <> NewData then begin
3166 if Data = nil then begin
3167 fInternalFormat := ifEmpty;
3171 if Width <> -1 then begin
3172 fDimension.Fields := fDimension.Fields + [ffX];
3173 fDimension.X := Width;
3176 if Height <> -1 then begin
3177 fDimension.Fields := fDimension.Fields + [ffY];
3178 fDimension.Y := Height;
3181 fInternalFormat := Format;
3182 fPixelSize := Trunc(FormatGetSize(InternalFormat));
3183 fRowSize := Trunc(FormatGetSize(InternalFormat) * Self.Width);
3187 {$ifdef GLB_SUPPORT_PNG_READ}
3188 {$ifdef GLB_LIB_PNG}
3189 procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
3191 TStream(png_get_io_ptr(png)).Read(buffer^, size);
3196 function TglBitmap.LoadPNG(Stream: TStream): Boolean;
3197 {$ifdef GLB_SDL_IMAGE}
3199 Surface: PSDL_Surface;
3204 RWops := glBitmapCreateRWops(Stream);
3206 if IMG_isPNG(RWops) > 0 then begin
3207 Surface := IMG_LoadPNG_RW(RWops);
3209 AssignFromSurface(Surface);
3212 SDL_FreeSurface(Surface);
3220 {$ifdef GLB_LIB_PNG}
3223 signature: array [0..7] of byte;
3225 png_info: png_infop;
3227 TempHeight, TempWidth: Integer;
3228 Format: TglBitmapInternalFormat;
3231 png_rows: array of pByte;
3232 Row, LineSize: Integer;
3236 if not init_libPNG then
3237 raise Exception.Create('LoadPNG - unable to initialize libPNG.');
3241 StreamPos := Stream.Position;
3242 Stream.Read(signature, 8);
3243 Stream.Position := StreamPos;
3245 if png_check_sig(@signature, 8) <> 0 then begin
3247 png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
3249 raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
3252 png_info := png_create_info_struct(png);
3253 if png_info = nil then begin
3254 png_destroy_read_struct(@png, nil, nil);
3255 raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
3258 // set read callback
3259 png_set_read_fn(png, stream, glBitmap_libPNG_read_func);
3261 // read informations
3262 png_read_info(png, png_info);
3265 TempHeight := png_get_image_height(png, png_info);
3266 TempWidth := png_get_image_width(png, png_info);
3269 case png_get_color_type(png, png_info) of
3270 PNG_COLOR_TYPE_GRAY:
3271 Format := ifLuminance;
3272 PNG_COLOR_TYPE_GRAY_ALPHA:
3273 Format := ifLuminanceAlpha;
3276 PNG_COLOR_TYPE_RGB_ALPHA:
3279 raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
3282 // cut upper 8 bit from 16 bit formats
3283 if png_get_bit_depth(png, png_info) > 8 then
3284 png_set_strip_16(png);
3286 // expand bitdepth smaller than 8
3287 if png_get_bit_depth(png, png_info) < 8 then
3288 png_set_expand(png);
3290 // allocating mem for scanlines
3291 LineSize := png_get_rowbytes(png, png_info);
3292 GetMem(png_data, TempHeight * LineSize);
3294 SetLength(png_rows, TempHeight);
3295 for Row := Low(png_rows) to High(png_rows) do begin
3296 png_rows[Row] := png_data;
3297 Inc(png_rows[Row], Row * LineSize);
3300 // read complete image into scanlines
3301 png_read_image(png, @png_rows[0]);
3304 png_read_end(png, png_info);
3306 // destroy read struct
3307 png_destroy_read_struct(@png, @png_info, nil);
3309 SetLength(png_rows, 0);
3312 SetDataPointer(png_data, Format, TempWidth, TempHeight);
3325 {$ifdef GLB_PNGIMAGE}
3329 Header: Array[0..7] of Byte;
3330 Row, Col, PixSize, LineSize: Integer;
3331 NewImage, pSource, pDest, pAlpha: pByte;
3332 Format: TglBitmapInternalFormat;
3335 PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
3340 StreamPos := Stream.Position;
3341 Stream.Read(Header[0], SizeOf(Header));
3342 Stream.Position := StreamPos;
3344 {Test if the header matches}
3345 if Header = PngHeader then begin
3346 Png := TPNGObject.Create;
3348 Png.LoadFromStream(Stream);
3350 case Png.Header.ColorType of
3352 Format := ifLuminance;
3353 COLOR_GRAYSCALEALPHA:
3354 Format := ifLuminanceAlpha;
3360 raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
3363 PixSize := Trunc(FormatGetSize(Format));
3364 LineSize := Integer(Png.Header.Width) * PixSize;
3366 GetMem(NewImage, LineSize * Integer(Png.Header.Height));
3370 case Png.Header.ColorType of
3371 COLOR_RGB, COLOR_GRAYSCALE:
3373 for Row := 0 to Png.Height -1 do begin
3374 Move (Png.Scanline[Row]^, pDest^, LineSize);
3375 Inc(pDest, LineSize);
3378 COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
3380 PixSize := PixSize -1;
3382 for Row := 0 to Png.Height -1 do begin
3383 pSource := Png.Scanline[Row];
3384 pAlpha := pByte(Png.AlphaScanline[Row]);
3386 for Col := 0 to Png.Width -1 do begin
3387 Move (pSource^, pDest^, PixSize);
3388 Inc(pSource, PixSize);
3389 Inc(pDest, PixSize);
3398 raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
3401 SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
3417 {$ifdef GLB_LIB_JPEG}
3419 glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
3420 glBitmap_libJPEG_source_mgr = record
3421 pub: jpeg_source_mgr;
3424 SrcBuffer: array [1..4096] of byte;
3428 glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
3429 glBitmap_libJPEG_dest_mgr = record
3430 pub: jpeg_destination_mgr;
3432 DestStream: TStream;
3433 DestBuffer: array [1..4096] of byte;
3438 procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
3442 // SetLength(Msg, 256);
3443 // cinfo^.err^.format_message(cinfo, pChar(Msg));
3445 // Writeln('ERROR [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
3447 // cinfo^.global_state := 0;
3449 // jpeg_abort(cinfo);
3453 procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
3457 // SetLength(Msg, 256);
3458 // cinfo^.err^.format_message(cinfo, pChar(Msg));
3460 // Writeln('OUTPUT [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
3462 // cinfo^.global_state := 0;
3466 procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
3471 function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
3473 src: glBitmap_libJPEG_source_mgr_ptr;
3476 src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
3478 bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
3479 if (bytes <= 0) then begin
3480 src^.SrcBuffer[1] := $FF;
3481 src^.SrcBuffer[2] := JPEG_EOI;
3485 src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
3486 src^.pub.bytes_in_buffer := bytes;
3492 procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
3494 src: glBitmap_libJPEG_source_mgr_ptr;
3496 src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
3498 if num_bytes > 0 then begin
3499 // wanted byte isn't in buffer so set stream position and read buffer
3500 if num_bytes > src^.pub.bytes_in_buffer then begin
3501 src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
3502 src^.pub.fill_input_buffer(cinfo);
3504 // wanted byte is in buffer so only skip
3505 inc(src^.pub.next_input_byte, num_bytes);
3506 dec(src^.pub.bytes_in_buffer, num_bytes);
3512 procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
3517 procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
3522 function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
3524 dest: glBitmap_libJPEG_dest_mgr_ptr;
3526 dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
3528 if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
3529 // write complete buffer
3530 dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
3533 dest^.pub.next_output_byte := @dest^.DestBuffer[1];
3534 dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
3541 procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
3544 dest: glBitmap_libJPEG_dest_mgr_ptr;
3546 dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
3548 for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
3549 // check for endblock
3550 if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
3552 dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
3557 dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
3563 {$ifdef GLB_SUPPORT_JPEG_READ}
3564 function TglBitmap.LoadJPEG(Stream: TStream): Boolean;
3565 {$ifdef GLB_SDL_IMAGE}
3567 Surface: PSDL_Surface;
3572 RWops := glBitmapCreateRWops(Stream);
3574 if IMG_isJPG(RWops) > 0 then begin
3575 Surface := IMG_LoadJPG_RW(RWops);
3577 AssignFromSurface(Surface);
3580 SDL_FreeSurface(Surface);
3588 {$ifdef GLB_LIB_JPEG}
3591 Temp: array[0..1]of Byte;
3593 jpeg: jpeg_decompress_struct;
3594 jpeg_err: jpeg_error_mgr;
3596 IntFormat: TglBitmapInternalFormat;
3598 TempHeight, TempWidth: Integer;
3605 if not init_libJPEG then
3606 raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
3609 // reading first two bytes to test file and set cursor back to begin
3610 StreamPos := Stream.Position;
3611 Stream.Read(Temp[0], 2);
3612 Stream.Position := StreamPos;
3614 // if Bitmap then read file.
3615 if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
3616 FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
3617 FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
3620 jpeg.err := jpeg_std_error(@jpeg_err);
3621 jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
3622 jpeg_err.output_message := glBitmap_libJPEG_output_message;
3624 // decompression struct
3625 jpeg_create_decompress(@jpeg);
3627 // allocation space for streaming methods
3628 jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
3630 // seeting up custom functions
3631 with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
3632 pub.init_source := glBitmap_libJPEG_init_source;
3633 pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
3634 pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
3635 pub.resync_to_restart := jpeg_resync_to_restart; // use default method
3636 pub.term_source := glBitmap_libJPEG_term_source;
3638 pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
3639 pub.next_input_byte := nil; // until buffer loaded
3641 SrcStream := Stream;
3644 // set global decoding state
3645 jpeg.global_state := DSTATE_START;
3647 // read header of jpeg
3648 jpeg_read_header(@jpeg, False);
3650 // setting output parameter
3651 case jpeg.jpeg_color_space of
3654 jpeg.out_color_space := JCS_GRAYSCALE;
3655 IntFormat := ifLuminance;
3658 jpeg.out_color_space := JCS_RGB;
3659 IntFormat := ifRGB8;
3663 jpeg_start_decompress(@jpeg);
3665 TempHeight := jpeg.output_height;
3666 TempWidth := jpeg.output_width;
3668 // creating new image
3669 GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
3673 for Row := 0 to TempHeight -1 do begin
3674 jpeg_read_scanlines(@jpeg, @pTemp, 1);
3675 Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
3678 // finish decompression
3679 jpeg_finish_decompress(@jpeg);
3681 // destroy decompression
3682 jpeg_destroy_decompress(@jpeg);
3684 SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
3697 {$ifdef GLB_DELPHI_JPEG}
3702 Temp: array[0..1]of Byte;
3706 // reading first two bytes to test file and set cursor back to begin
3707 StreamPos := Stream.Position;
3708 Stream.Read(Temp[0], 2);
3709 Stream.Position := StreamPos;
3711 // if Bitmap then read file.
3712 if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
3713 bmp := TBitmap.Create;
3715 jpg := TJPEGImage.Create;
3717 jpg.LoadFromStream(Stream);
3719 Result := AssignFromBitmap(bmp);
3738 BMP_COMP_BITFIELDS = 3;
3741 TBMPHeader = packed record
3746 bfOffBits: Cardinal;
3749 TBMPInfo = packed record
3755 biCompression: Cardinal;
3756 biSizeImage: Cardinal;
3757 biXPelsPerMeter: Longint;
3758 biYPelsPerMeter: Longint;
3759 biClrUsed: Cardinal;
3760 biClrImportant: Cardinal;
3763 TBMPInfoOS = packed record
3771 // TBMPPalette = record
3773 // True : (Colors: array[Byte] of TRGBQUAD);
3774 // False: (redMask, greenMask, blueMask: Cardinal);
3777 function TglBitmap.LoadBMP(Stream: TStream): Boolean;
3782 NewImage, pData: pByte;
3784 Format: TglBitmapInternalFormat;
3785 LineSize, Padding, LineIdx: Integer;
3786 RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
3788 PaddingBuff: Cardinal;
3791 function GetLineWidth : Integer;
3793 Result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
3806 StreamPos := Stream.Position;
3807 Stream.Read(Header, SizeOf(Header));
3809 if Header.bfType = BMP_MAGIC then begin
3810 Stream.Read(Info, SizeOf(Info));
3812 // Check for Compression
3813 if Info.biCompression <> BMP_COMP_RGB then begin
3814 if Info.biCompression = BMP_COMP_BITFIELDS then begin
3815 // Read Bitmasks for 16 or 32 Bit (24 Bit dosn't support Bitmasks!)
3816 if (Info.biBitCount = 16) or (Info.biBitCount = 32) then begin
3817 Stream.Read(RedMask, SizeOf(Cardinal));
3818 Stream.Read(GreenMask, SizeOf(Cardinal));
3819 Stream.Read(BlueMask, SizeOf(Cardinal));
3820 Stream.Read(AlphaMask, SizeOf(Cardinal));
3823 // RLE compression is unsupported
3824 Stream.Position := StreamPos;
3831 if Info.biBitCount < 16 then
3832 Stream.Position := Stream.Position + Info.biClrUsed * 4;
3835 Stream.Position := StreamPos + Header.bfOffBits;
3838 case Info.biBitCount of
3839 8 : Format := ifLuminance;
3842 if (RedMask = 0) and (GreenMask = 0) and (BlueMask = 0) then begin
3845 if FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask, ifLuminanceAlpha) then
3846 Format := ifLuminanceAlpha;
3848 if FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask, ifRGBA4) then
3851 if FormatCheckFormat(RedMask, GreenMask, BlueMask, 0, ifRGB5A1) then
3854 if FormatCheckFormat(RedMask, GreenMask, BlueMask, 0, ifR5G6B5) then
3858 24: Format := ifBGR8;
3861 if (RedMask = 0) and (GreenMask = 0) and (BlueMask = 0) then begin
3864 if FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask, ifRGBA8) then
3867 if FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask, ifBGRA8) then
3870 if FormatCheckFormat(RedMask, GreenMask, BlueMask, AlphaMask, ifRGB10A2) then
3871 Format := ifRGB10A2;
3876 if Format <> ifEmpty then begin
3877 LineSize := Trunc(Info.biWidth * FormatGetSize(Format));
3878 Padding := GetLineWidth - LineSize;
3881 GetMem(NewImage, Info.biHeight * LineSize);
3883 FillChar(NewImage^, Info.biHeight * LineSize, $FF);
3885 // Set pData to last Line
3887 Inc(pData, LineSize * (Info.biHeight -1));
3890 for LineIdx := 0 to Info.biHeight - 1 do begin
3891 Stream.Read(pData^, LineSize);
3892 Dec(pData, LineSize);
3894 Stream.Read(PaddingBuff, Padding);
3898 SetDataPointer(NewImage, Format, Info.biWidth, Info.biHeight);
3907 else Stream.Position := StreamPos;
3912 DDS_MAGIC = $20534444;
3914 // DDS_header.dwFlags
3915 DDSD_CAPS = $00000001;
3916 DDSD_HEIGHT = $00000002;
3917 DDSD_WIDTH = $00000004;
3918 DDSD_PITCH = $00000008;
3919 DDSD_PIXELFORMAT = $00001000;
3920 DDSD_MIPMAPCOUNT = $00020000;
3921 DDSD_LINEARSIZE = $00080000;
3922 DDSD_DEPTH = $00800000;
3924 // DDS_header.sPixelFormat.dwFlags
3925 DDPF_ALPHAPIXELS = $00000001;
3926 DDPF_FOURCC = $00000004;
3927 DDPF_INDEXED = $00000020;
3928 DDPF_RGB = $00000040;
3930 // DDS_header.sCaps.dwCaps1
3931 DDSCAPS_COMPLEX = $00000008;
3932 DDSCAPS_TEXTURE = $00001000;
3933 DDSCAPS_MIPMAP = $00400000;
3935 // DDS_header.sCaps.dwCaps2
3936 DDSCAPS2_CUBEMAP = $00000200;
3937 DDSCAPS2_CUBEMAP_POSITIVEX = $00000400;
3938 DDSCAPS2_CUBEMAP_NEGATIVEX = $00000800;
3939 DDSCAPS2_CUBEMAP_POSITIVEY = $00001000;
3940 DDSCAPS2_CUBEMAP_NEGATIVEY = $00002000;
3941 DDSCAPS2_CUBEMAP_POSITIVEZ = $00004000;
3942 DDSCAPS2_CUBEMAP_NEGATIVEZ = $00008000;
3943 DDSCAPS2_VOLUME = $00200000;
3945 D3DFMT_DXT1 = $31545844;
3946 D3DFMT_DXT3 = $33545844;
3947 D3DFMT_DXT5 = $35545844;
3950 TDDSPixelFormat = packed record
3954 dwRGBBitCount: Cardinal;
3955 dwRBitMask: Cardinal;
3956 dwGBitMask: Cardinal;
3957 dwBBitMask: Cardinal;
3958 dwAlphaBitMask: Cardinal;
3961 TDDSCaps = packed record
3965 dwReserved: Cardinal;
3968 TDDSHeader = packed record
3974 dwPitchOrLinearSize: Cardinal;
3976 dwMipMapCount: Cardinal;
3977 dwReserved: array[0..10] of Cardinal;
3978 PixelFormat: TDDSPixelFormat;
3980 dwReserved2: Cardinal;
3984 function TglBitmap.LoadDDS(Stream: TStream): Boolean;
3988 Y, LineSize: Cardinal;
3990 // MipMapCount, X, Y, XSize, YSize: Cardinal;
3992 NewImage, pData: pByte;
3993 Format: TglBitmapInternalFormat;
3996 function RaiseEx : Exception;
3998 Result := EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
4002 function GetInternalFormat: TglBitmapInternalFormat;
4004 with Header.PixelFormat do begin
4006 if (dwFlags and DDPF_FOURCC) > 0 then begin
4007 case Header.PixelFormat.dwFourCC of
4008 D3DFMT_DXT1: Result := ifDXT1;
4009 D3DFMT_DXT3: Result := ifDXT3;
4010 D3DFMT_DXT5: Result := ifDXT5;
4017 if (dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin
4018 case dwRGBBitCount of
4021 if dwFlags and DDPF_ALPHAPIXELS > 0 then
4024 Result := ifLuminance;
4028 if dwFlags and DDPF_ALPHAPIXELS > 0 then begin
4030 case GetBitSize(dwRBitMask) of
4031 5: Result := ifRGB5A1;
4032 4: Result := ifRGBA4;
4034 Result := ifLuminanceAlpha;
4043 if dwRBitMask > dwBBitMask then
4050 if GetBitSize(dwRBitMask) = 10 then
4054 if dwRBitMask > dwBBitMask then
4071 StreamPos := Stream.Position;
4072 Stream.Read(Header, sizeof(Header));
4074 if ((Header.dwMagic <> DDS_MAGIC) or (Header.dwSize <> 124) or
4075 ((Header.dwFlags and DDSD_PIXELFORMAT) = 0) or ((Header.dwFlags and DDSD_CAPS) = 0)) then begin
4076 Stream.Position := StreamPos;
4081 // if Header.dwFlags and DDSD_MIPMAPCOUNT <> 0
4082 // then MipMapCount := Header.dwMipMapCount
4083 // else MipMapCount := 1;
4085 Format := GetInternalFormat;
4086 LineSize := Trunc(Header.dwWidth * FormatGetSize(Format));
4088 GetMem(NewImage, Header.dwHeight * LineSize);
4093 if (Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0 then begin
4094 RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
4096 for Y := 0 to Header.dwHeight -1 do begin
4097 Stream.Read(pData^, RowSize);
4098 Inc(pData, LineSize);
4103 if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin
4104 RowSize := Header.dwPitchOrLinearSize;
4106 for Y := 0 to Header.dwHeight -1 do begin
4107 Stream.Read(pData^, RowSize);
4108 Inc(pData, LineSize);
4113 SetDataPointer(NewImage, Format, Header.dwWidth, Header.dwHeight);
4124 TTGAHeader = packed record
4128 ColorMapSpec: Array[0..4] of Byte;
4138 TGA_UNCOMPRESSED_RGB = 2;
4139 TGA_UNCOMPRESSED_GRAY = 3;
4140 TGA_COMPRESSED_RGB = 10;
4141 TGA_COMPRESSED_GRAY = 11;
4145 function TglBitmap.LoadTGA(Stream: TStream): Boolean;
4148 NewImage, pData: PByte;
4150 PixelSize, LineSize, YStart, YEnd, YInc: Integer;
4151 Format: TglBitmapInternalFormat;
4156 procedure ReadUncompressed;
4160 RowSize := Header.Width * PixelSize;
4162 // copy line by line
4163 while YStart <> YEnd + YInc do begin
4165 Inc(pData, YStart * LineSize);
4167 Stream.Read(pData^, RowSize);
4173 procedure ReadCompressed;
4175 HeaderWidth, HeaderHeight: Integer;
4176 LinePixelsRead, ImgPixelsRead, ImgPixelsToRead: Integer;
4179 CacheSize, CachePos: Integer;
4182 TempBuf: Array [0..15] of Byte;
4184 PixelRepeat: Boolean;
4185 PixelToRead, TempPixels: Integer;
4188 procedure CheckLine;
4190 if LinePixelsRead >= HeaderWidth then begin
4191 LinePixelsRead := 0;
4194 Inc(pData, YStart * LineSize);
4199 procedure CachedRead(var Buffer; Count: Integer);
4203 if (CachePos + Count) > CacheSize then begin
4207 if CacheSize - CachePos > 0 then begin
4208 BytesRead := CacheSize - CachePos;
4210 Move(pByteArray(Cache)^[CachePos], Buffer, BytesRead);
4211 Inc(CachePos, BytesRead);
4215 CacheSize := Min(CACHE_SIZE, Stream.Size - Stream.Position);
4216 Stream.Read(Cache^, CacheSize);
4220 if Count - BytesRead > 0 then begin
4221 Move(pByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
4222 Inc(CachePos, Count - BytesRead);
4225 Move(pByteArray(Cache)^[CachePos], Buffer, Count);
4226 Inc(CachePos, Count);
4235 HeaderWidth := Header.Width;
4236 HeaderHeight := Header.Height;
4238 GetMem(Cache, CACHE_SIZE); // 16K Buffer
4240 ImgPixelsToRead := HeaderWidth * HeaderHeight;
4242 LinePixelsRead := 0;
4245 Inc(pData, YStart * LineSize);
4247 // Read until all Pixels
4249 CachedRead(Temp, 1);
4251 PixelRepeat := Temp and $80 > 0;
4252 PixelToRead := (Temp and $7F) + 1;
4254 Inc(ImgPixelsRead, PixelToRead);
4256 if PixelRepeat then begin
4257 // repeat one pixel x times
4258 CachedRead(TempBuf[0], PixelSize);
4261 while PixelToRead > 0 do begin
4264 TempPixels := HeaderWidth - LinePixelsRead;
4265 if PixelToRead < TempPixels then
4266 TempPixels := PixelToRead;
4268 Inc(LinePixelsRead, TempPixels);
4269 Dec(PixelToRead, TempPixels);
4271 while TempPixels > 0 do begin
4275 pData^ := TempBuf[0];
4280 pWord(pData)^ := pWord(@TempBuf[0])^;
4285 pWord(pData)^ := pWord(@TempBuf[0])^;
4287 pData^ := TempBuf[2];
4292 pDWord(pData)^ := pDWord(@TempBuf[0])^;
4302 while PixelToRead > 0 do begin
4305 TempPixels := HeaderWidth - LinePixelsRead;
4306 if PixelToRead < TempPixels then
4307 TempPixels := PixelToRead;
4309 CachedRead(pData^, PixelSize * TempPixels);
4310 Inc(pData, PixelSize * TempPixels);
4312 Inc(LinePixelsRead, TempPixels);
4314 Dec(PixelToRead, TempPixels);
4317 until ImgPixelsRead >= ImgPixelsToRead;
4326 // reading header to test file and set cursor back to begin
4327 StreamPos := Stream.Position;
4328 Stream.Read(Header, SizeOf(Header));
4330 // no colormapped files
4331 if (Header.ColorMapType = 0) then begin
4332 if Header.ImageType in [TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY] then begin
4334 8: Format := ifAlpha;
4335 16: Format := ifLuminanceAlpha;
4336 24: Format := ifBGR8;
4337 32: Format := ifBGRA8;
4339 raise EglBitmapException.Create('LoadTga - unsupported BitsPerPixel found.');
4343 if Header.ImageID <> 0 then
4344 Stream.Position := Stream.Position + Header.ImageID;
4346 PixelSize := Trunc(FormatGetSize(Format));
4347 LineSize := Trunc(Header.Width * PixelSize);
4349 GetMem(NewImage, LineSize * Header.Height);
4352 if (Header.ImageDes and $20 > 0) then begin
4354 YEnd := Header.Height -1;
4357 YStart := Header.Height -1;
4363 case Header.ImageType of
4364 TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
4366 TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
4370 SetDataPointer(NewImage, Format, Header.Width, Header.Height);
4378 else Stream.Position := StreamPos;
4380 else Stream.Position := StreamPos;
4384 {$ifdef GLB_SUPPORT_PNG_WRITE}
4385 {$ifdef GLB_LIB_PNG}
4386 procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
4388 TStream(png_get_io_ptr(png)).Write(buffer^, size);
4392 procedure TglBitmap.SavePNG(Stream: TStream);
4393 {$ifdef GLB_LIB_PNG}
4396 png_info: png_infop;
4397 png_rows: array of pByte;
4402 if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
4403 raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
4405 if not init_libPNG then
4406 raise Exception.Create('SavePNG - unable to initialize libPNG.');
4409 case FInternalFormat of
4410 ifAlpha, ifLuminance, ifDepth8:
4411 ColorType := PNG_COLOR_TYPE_GRAY;
4413 ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
4415 ColorType := PNG_COLOR_TYPE_RGB;
4417 ColorType := PNG_COLOR_TYPE_RGBA;
4419 raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
4422 LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);
4424 // creating array for scanline
4425 SetLength(png_rows, Height);
4427 for Row := 0 to Height - 1 do begin
4428 png_rows[Row] := Data;
4429 Inc(png_rows[Row], Row * LineSize)
4433 png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
4435 raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
4438 png_info := png_create_info_struct(png);
4439 if png_info = nil then begin
4440 png_destroy_write_struct(@png, nil);
4441 raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
4444 // set read callback
4445 png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);
4448 png_set_compression_level(png, 6);
4450 if InternalFormat in [ifBGR8, ifBGRA8] then
4454 png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
4457 png_write_info(png, png_info);
4460 png_write_image(png, @png_rows[0]);
4463 png_write_end(png, png_info);
4465 // destroy write struct
4466 png_destroy_write_struct(@png, @png_info);
4468 SetLength(png_rows, 0);
4475 {$ifdef GLB_PNGIMAGE}
4479 pSource, pDest: pByte;
4480 X, Y, PixSize: Integer;
4481 ColorType: Cardinal;
4487 if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
4488 raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
4490 case FInternalFormat of
4491 ifAlpha, ifLuminance, ifDepth8:
4493 ColorType := COLOR_GRAYSCALE;
4499 ColorType := COLOR_GRAYSCALEALPHA;
4505 ColorType := COLOR_RGB;
4511 ColorType := COLOR_RGBALPHA;
4516 raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
4519 Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
4523 for Y := 0 to Height -1 do begin
4524 pDest := png.ScanLine[Y];
4526 for X := 0 to Width -1 do begin
4527 Move(pSource^, pDest^, PixSize);
4529 Inc(pDest, PixSize);
4530 Inc(pSource, PixSize);
4533 png.AlphaScanline[Y]^[X] := pSource^;
4538 // convert RGB line to BGR
4539 if InternalFormat in [ifRGB8, ifRGBA8] then begin
4540 pTemp := png.ScanLine[Y];
4542 for X := 0 to Width -1 do begin
4543 Temp := pByteArray(pTemp)^[0];
4544 pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
4545 pByteArray(pTemp)^[2] := Temp;
4553 Png.CompressionLevel := 6;
4554 Png.SaveToStream(Stream);
4563 procedure TglBitmap.SaveDDS(Stream: TStream);
4566 Pix: TglBitmapPixelData;
4568 if not FormatIsUncompressed(InternalFormat) then
4569 raise EglBitmapUnsupportedInternalFormat.Create('SaveDDS - ' + UNSUPPORTED_INTERNAL_FORMAT);
4571 if InternalFormat = ifAlpha then
4572 FormatPreparePixel(Pix, ifLuminance)
4574 FormatPreparePixel(Pix, InternalFormat);
4577 FillChar(Header, SizeOf(Header), 0);
4579 Header.dwMagic := DDS_MAGIC;
4580 Header.dwSize := 124;
4581 Header.dwFlags := DDSD_PITCH or DDSD_CAPS or DDSD_PIXELFORMAT;
4583 if Width > 0 then begin
4584 Header.dwWidth := Width;
4585 Header.dwFlags := Header.dwFlags or DDSD_WIDTH;
4588 if Height > 0 then begin
4589 Header.dwHeight := Height;
4590 Header.dwFlags := Header.dwFlags or DDSD_HEIGHT;
4593 Header.dwPitchOrLinearSize := fRowSize;
4594 Header.dwMipMapCount := 1;
4597 Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
4600 Header.PixelFormat.dwSize := Sizeof(Header.PixelFormat);
4601 Header.PixelFormat.dwFlags := DDPF_RGB;
4603 if FormatHasAlpha(InternalFormat) and (InternalFormat <> ifAlpha)
4604 then Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
4606 Header.PixelFormat.dwRGBBitCount := Trunc(FormatGetSize(InternalFormat) * 8);
4607 Header.PixelFormat.dwRBitMask := Pix.PixelDesc.RedRange shl Pix.PixelDesc.RedShift;
4608 Header.PixelFormat.dwGBitMask := Pix.PixelDesc.GreenRange shl Pix.PixelDesc.GreenShift;
4609 Header.PixelFormat.dwBBitMask := Pix.PixelDesc.BlueRange shl Pix.PixelDesc.BlueShift;
4610 Header.PixelFormat.dwAlphaBitMask := Pix.PixelDesc.AlphaRange shl Pix.PixelDesc.AlphaShift;
4613 Stream.Write(Header, SizeOf(Header));
4615 Stream.Write(Data^, FormatGetImageSize(glBitmapPosition(Width, Height), InternalFormat));
4619 procedure TglBitmap.SaveTGA(Stream: TStream);
4626 procedure ConvertData(pTemp: pByte);
4628 Idx, PixelSize: Integer;
4631 PixelSize := fPixelSize;
4633 for Idx := 1 to Height * Width do begin
4634 Temp := pByteArray(pTemp)^[2];
4635 pByteArray(pTemp)^[2] := pByteArray(pTemp)^[0];
4636 pByteArray(pTemp)^[0] := Temp;
4638 Inc(pTemp, PixelSize);
4644 if not (ftTGA in FormatGetSupportedFiles (InternalFormat)) then
4645 raise EglBitmapUnsupportedInternalFormat.Create('SaveTGA - ' + UNSUPPORTED_INTERNAL_FORMAT);
4647 FillChar(Header, SizeOf(Header), 0);
4649 case InternalFormat of
4650 ifAlpha, ifLuminance, ifDepth8:
4652 Header.ImageType := TGA_UNCOMPRESSED_GRAY;
4657 Header.ImageType := TGA_UNCOMPRESSED_GRAY;
4662 Header.ImageType := TGA_UNCOMPRESSED_RGB;
4667 Header.ImageType := TGA_UNCOMPRESSED_RGB;
4671 raise EglBitmapUnsupportedInternalFormat.Create('SaveTGA - ' + UNSUPPORTED_INTERNAL_FORMAT);
4674 Header.Width := Width;
4675 Header.Height := Height;
4676 Header.ImageDes := $20;
4678 if FormatHasAlpha(InternalFormat) then
4679 Header.ImageDes := Header.ImageDes or $08;
4681 Stream.Write(Header, SizeOf(Header));
4683 // convert RGB(A) to BGR(A)
4684 Size := FormatGetImageSize(glBitmapPosition(Width, Height), InternalFormat);
4685 if InternalFormat in [ifRGB8, ifRGBA8] then begin
4686 GetMem(pTemp, Size);
4692 if InternalFormat in [ifRGB8, ifRGBA8] then begin
4693 Move(Data^, pTemp^, Size);
4698 Stream.Write(pTemp^, Size);
4701 if InternalFormat in [ifRGB8, ifRGBA8] then
4707 {$ifdef GLB_SUPPORT_JPEG_WRITE}
4708 procedure TglBitmap.SaveJPEG(Stream: TStream);
4709 {$ifdef GLB_LIB_JPEG}
4711 jpeg: jpeg_compress_struct;
4712 jpeg_err: jpeg_error_mgr;
4714 pTemp, pTemp2: pByte;
4717 procedure CopyRow(pDest, pSource: pByte);
4721 for X := 0 to Width - 1 do begin
4722 pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
4723 pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
4724 pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
4732 if not (ftJPEG in FormatGetSupportedFiles(InternalFormat)) then
4733 raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
4735 if not init_libJPEG then
4736 raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
4739 FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
4740 FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
4743 jpeg.err := jpeg_std_error(@jpeg_err);
4744 jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
4745 jpeg_err.output_message := glBitmap_libJPEG_output_message;
4747 // compression struct
4748 jpeg_create_compress(@jpeg);
4750 // allocation space for streaming methods
4751 jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
4753 // seeting up custom functions
4754 with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
4755 pub.init_destination := glBitmap_libJPEG_init_destination;
4756 pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
4757 pub.term_destination := glBitmap_libJPEG_term_destination;
4759 pub.next_output_byte := @DestBuffer[1];
4760 pub.free_in_buffer := Length(DestBuffer);
4762 DestStream := Stream;
4765 // very important state
4766 jpeg.global_state := CSTATE_START;
4768 jpeg.image_width := Width;
4769 jpeg.image_height := Height;
4770 case InternalFormat of
4771 ifAlpha, ifLuminance, ifDepth8:
4773 jpeg.input_components := 1;
4774 jpeg.in_color_space := JCS_GRAYSCALE;
4778 jpeg.input_components := 3;
4779 jpeg.in_color_space := JCS_RGB;
4784 jpeg_set_defaults(@jpeg);
4786 // compression quality
4787 jpeg_set_quality(@jpeg, 95, True);
4789 // start compression
4790 jpeg_start_compress(@jpeg, true);
4796 if InternalFormat = ifBGR8 then
4797 GetMem(pTemp2, fRowSize)
4802 for Row := 0 to jpeg.image_height -1 do begin
4804 if InternalFormat = ifBGR8 then
4805 CopyRow(pTemp2, pTemp)
4810 jpeg_write_scanlines(@jpeg, @pTemp2, 1);
4811 inc(pTemp, fRowSize);
4815 if InternalFormat = ifBGR8 then
4819 // finish compression
4820 jpeg_finish_compress(@jpeg);
4822 // destroy compression
4823 jpeg_destroy_compress(@jpeg);
4829 {$ifdef GLB_DELPHI_JPEG}
4834 if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
4835 raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
4837 Bmp := TBitmap.Create;
4839 Jpg := TJPEGImage.Create;
4841 AssignToBitmap(Bmp);
4843 if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
4844 Jpg.Grayscale := True;
4845 Jpg.PixelFormat := jf8Bit;
4850 Jpg.SaveToStream(Stream);
4862 procedure TglBitmap.SaveBMP(Stream: TStream);
4866 pData, pTemp: pByte;
4868 PixelFormat: TglBitmapPixelData;
4869 ImageSize, LineSize, Padding, LineIdx, ColorIdx: Integer;
4870 Temp, RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
4872 PaddingBuff: Cardinal;
4875 function GetLineWidth : Integer;
4877 Result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
4882 if not (ftBMP in FormatGetSupportedFiles(InternalFormat)) then
4883 raise EglBitmapUnsupportedInternalFormat.Create('SaveBMP - ' + UNSUPPORTED_INTERNAL_FORMAT);
4885 ImageSize := Trunc(Width * Height * FormatGetSize(InternalFormat));
4887 Header.bfType := BMP_MAGIC;
4888 Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
4889 Header.bfReserved1 := 0;
4890 Header.bfReserved2 := 0;
4891 Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
4893 FillChar(Info, SizeOf(Info), 0);
4894 Info.biSize := SizeOf(Info);
4895 Info.biWidth := Width;
4896 Info.biHeight := Height;
4898 Info.biCompression := BMP_COMP_RGB;
4899 Info.biSizeImage := ImageSize;
4900 case InternalFormat of
4901 ifAlpha, ifLuminance, ifDepth8:
4903 Info.biBitCount := 8;
4905 Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
4906 Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal);
4908 Info.biClrUsed := 256;
4909 Info.biClrImportant := 256;
4911 ifLuminanceAlpha, ifRGBA4, ifR5G6B5, ifRGB5A1:
4913 Info.biBitCount := 16;
4914 Info.biCompression := BMP_COMP_BITFIELDS;
4917 Info.biBitCount := 24;
4918 ifBGRA8, ifRGBA8, ifRGB10A2:
4920 Info.biBitCount := 32;
4921 Info.biCompression := BMP_COMP_BITFIELDS;
4924 raise EglBitmapUnsupportedInternalFormat.Create('SaveBMP - ' + UNSUPPORTED_INTERNAL_FORMAT);
4926 Info.biXPelsPerMeter := 2835;
4927 Info.biYPelsPerMeter := 2835;
4930 if Info.biCompression = BMP_COMP_BITFIELDS then begin
4931 Info.biSize := Info.biSize + 4 * SizeOf(Cardinal);
4932 Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
4933 Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
4935 FormatPreparePixel(PixelFormat, InternalFormat);
4937 with PixelFormat.PixelDesc do begin
4938 RedMask := RedRange shl RedShift;
4939 GreenMask := GreenRange shl GreenShift;
4940 BlueMask := BlueRange shl BlueShift;
4941 AlphaMask := AlphaRange shl AlphaShift;
4946 Stream.Write(Header, SizeOf(Header));
4947 Stream.Write(Info, SizeOf(Info));
4950 if Info.biBitCount = 8 then begin
4952 for ColorIdx := Low(Byte) to High(Byte) do begin
4953 Stream.Write(Temp, 4);
4954 Temp := Temp + $00010101;
4959 if Info.biCompression = BMP_COMP_BITFIELDS then begin
4960 Stream.Write(RedMask, SizeOf(Cardinal));
4961 Stream.Write(GreenMask, SizeOf(Cardinal));
4962 Stream.Write(BlueMask, SizeOf(Cardinal));
4963 Stream.Write(AlphaMask, SizeOf(Cardinal));
4967 LineSize := Trunc(Width * FormatGetSize(InternalFormat));
4968 Padding := GetLineWidth - LineSize;
4972 Inc(pData, (Height -1) * LineSize);
4974 // prepare row buffer. But only for RGB because RGBA supports color masks
4975 // so it's possible to change color within the image.
4976 if InternalFormat = ifRGB8 then
4977 GetMem(pTemp, fRowSize)
4983 for LineIdx := 0 to Height - 1 do begin
4985 if InternalFormat = ifRGB8 then begin
4986 Move(pData^, pTemp^, fRowSize);
4987 SwapRGB(pTemp, Width, False);
4991 Stream.Write(pTemp^, LineSize);
4993 Dec(pData, LineSize);
4996 Stream.Write(PaddingBuff, Padding);
4999 // destroy row buffer
5000 if InternalFormat = ifRGB8 then
5006 procedure TglBitmap.Bind(EnableTextureUnit: Boolean);
5008 if EnableTextureUnit then
5012 glBindTexture(Target, ID);
5016 procedure TglBitmap.Unbind(DisableTextureUnit: Boolean);
5018 if DisableTextureUnit then
5021 glBindTexture(Target, 0);
5025 procedure TglBitmap.GetPixel(const Pos: TglBitmapPixelPosition;
5026 var Pixel: TglBitmapPixelData);
5028 if Assigned (fGetPixelFunc) then
5029 fGetPixelFunc(Pos, Pixel);
5033 procedure TglBitmap.SetPixel (const Pos: TglBitmapPixelPosition;
5034 const Pixel: TglBitmapPixelData);
5036 if Assigned (fSetPixelFunc) then
5037 fSetPixelFunc(Pos, Pixel);
5041 procedure TglBitmap.CreateID;
5045 glDeleteTextures(1, @ID);
5047 glGenTextures(1, @ID);
5053 procedure TglBitmap.SetupParameters(var BuildWithGlu: Boolean);
5055 // Set up parameters
5056 SetWrap(fWrapS, fWrapT, fWrapR);
5057 SetFilter(fFilterMin, fFilterMag);
5058 SetAnisotropic(fAnisotropic);
5059 SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
5061 // Mip Maps generation Mode
5062 BuildWithGlu := False;
5064 if (MipMap = mmMipmap) then begin
5065 if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
5066 glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
5068 BuildWithGlu := True;
5070 if (MipMap = mmMipmapGlu) then
5071 BuildWithGlu := True;
5075 procedure TglBitmap.SelectFormat(DataFormat: TglBitmapInternalFormat; var glFormat, glInternalFormat, glType: Cardinal; CanConvertImage: Boolean = True);
5079 if not GL_VERSION_1_2 then
5080 raise EglBitmapUnsupportedInternalFormat.Create('SelectFormat - You need at least OpenGL 1.2 to support these format.');
5084 glType := GL_UNSIGNED_BYTE;
5089 glFormat := GL_ALPHA;
5091 glFormat := GL_LUMINANCE;
5093 glFormat := GL_DEPTH_COMPONENT;
5095 glFormat := GL_LUMINANCE_ALPHA;
5098 if (GL_VERSION_1_2 or GL_EXT_bgra) then begin
5101 if CanConvertImage then
5108 if (GL_VERSION_1_2 or GL_EXT_bgra) then begin
5109 glFormat := GL_BGRA;
5111 if CanConvertImage then
5113 glFormat := GL_RGBA;
5119 glFormat := GL_RGBA;
5123 glFormat := GL_BGRA;
5124 glType := GL_UNSIGNED_SHORT_4_4_4_4_REV;
5129 glFormat := GL_BGRA;
5130 glType := GL_UNSIGNED_SHORT_1_5_5_5_REV;
5135 glFormat := GL_BGRA;
5136 glType := GL_UNSIGNED_INT_2_10_10_10_REV;
5142 glType := GL_UNSIGNED_SHORT_5_6_5;
5148 // Selecting InternalFormat
5150 ifDXT1, ifDXT3, ifDXT5:
5152 if GL_EXT_texture_compression_s3tc then begin
5155 glInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
5157 glInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
5159 glInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
5162 // Compression isn't supported so convert to RGBA
5163 if CanConvertImage then
5165 glFormat := GL_RGBA;
5166 glInternalFormat := GL_RGBA8;
5173 glInternalFormat := GL_ALPHA4;
5175 glInternalFormat := GL_ALPHA8;
5178 if (GL_ARB_texture_compression or GL_VERSION_1_3) then
5179 glInternalFormat := GL_COMPRESSED_ALPHA
5181 glInternalFormat := GL_ALPHA;
5184 glInternalFormat := GL_ALPHA;
5191 glInternalFormat := GL_LUMINANCE4;
5193 glInternalFormat := GL_LUMINANCE8;
5196 if (GL_ARB_texture_compression or GL_VERSION_1_3) then
5197 glInternalFormat := GL_COMPRESSED_LUMINANCE
5199 glInternalFormat := GL_LUMINANCE;
5202 glInternalFormat := GL_LUMINANCE;
5207 glInternalFormat := GL_DEPTH_COMPONENT;
5213 glInternalFormat := GL_LUMINANCE4_ALPHA4;
5215 glInternalFormat := GL_LUMINANCE8_ALPHA8;
5218 if (GL_ARB_texture_compression or GL_VERSION_1_3) then
5219 glInternalFormat := GL_COMPRESSED_LUMINANCE_ALPHA
5221 glInternalFormat := GL_LUMINANCE_ALPHA;
5224 glInternalFormat := GL_LUMINANCE_ALPHA;
5231 glInternalFormat := GL_RGB4;
5233 glInternalFormat := GL_RGB8;
5236 if (GL_ARB_texture_compression or GL_VERSION_1_3) then begin
5237 glInternalFormat := GL_COMPRESSED_RGB
5239 if (GL_EXT_texture_compression_s3tc) then
5240 glInternalFormat := GL_COMPRESSED_RGB_S3TC_DXT1_EXT
5242 glInternalFormat := GL_RGB;
5246 glInternalFormat := GL_RGB;
5249 ifBGRA8, ifRGBA8, ifRGBA4, ifRGB5A1, ifRGB10A2, ifR5G6B5:
5253 glInternalFormat := GL_RGBA4;
5255 glInternalFormat := GL_RGBA8;
5258 if (GL_ARB_texture_compression or GL_VERSION_1_3) then begin
5259 glInternalFormat := GL_COMPRESSED_RGBA
5261 if (GL_EXT_texture_compression_s3tc) then
5262 glInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT
5264 glInternalFormat := GL_RGBA;
5268 glInternalFormat := GL_RGBA;
5275 function TglBitmap.FlipHorz: Boolean;
5281 function TglBitmap.FlipVert: Boolean;
5287 procedure TglBitmap.FreeData;
5289 SetDataPointer(nil, ifEmpty);
5293 procedure glBitmapFillWithColorFunc(var FuncRec: TglBitmapFunctionRec);
5295 PglBitmapPixelData = ^TglBitmapPixelData;
5297 with FuncRec do begin
5298 Dest.Red := PglBitmapPixelData(CustomData)^.Red;
5299 Dest.Green := PglBitmapPixelData(CustomData)^.Green;
5300 Dest.Blue := PglBitmapPixelData(CustomData)^.Blue;
5301 Dest.Alpha := PglBitmapPixelData(CustomData)^.Alpha;
5306 procedure TglBitmap.FillWithColor(Red, Green, Blue, Alpha: Byte);
5308 FillWithColorFloat(Red / $FF, Green / $FF, Blue / $FF, Alpha / $FF);
5312 procedure TglBitmap.FillWithColorFloat(Red, Green, Blue, Alpha: Single);
5314 PixelData: TglBitmapPixelData;
5316 FormatPreparePixel(PixelData, InternalFormat);
5318 PixelData.Red := Max(0, Min(PixelData.PixelDesc.RedRange, Trunc(PixelData.PixelDesc.RedRange * Red)));
5319 PixelData.Green := Max(0, Min(PixelData.PixelDesc.GreenRange, Trunc(PixelData.PixelDesc.GreenRange * Green)));
5320 PixelData.Blue := Max(0, Min(PixelData.PixelDesc.BlueRange, Trunc(PixelData.PixelDesc.BlueRange * Blue)));
5321 PixelData.Alpha := Max(0, Min(PixelData.PixelDesc.AlphaRange, Trunc(PixelData.PixelDesc.AlphaRange * Alpha)));
5323 AddFunc(glBitmapFillWithColorFunc, False, @PixelData);
5327 procedure TglBitmap.FillWithColorRange(Red, Green, Blue, Alpha: Cardinal);
5329 PixelData: TglBitmapPixelData;
5331 FormatPreparePixel(PixelData, FormatGetWithAlpha(InternalFormat));
5334 Red / PixelData.PixelDesc.RedRange,
5335 Green / PixelData.PixelDesc.GreenRange,
5336 Blue / PixelData.PixelDesc.BlueRange,
5337 Alpha / PixelData.PixelDesc.AlphaRange);
5341 procedure TglBitmap.SetAnisotropic(const Value: Integer);
5345 fAnisotropic := Value;
5347 if (ID > 0) then begin
5348 if GL_EXT_texture_filter_anisotropic then begin
5349 if fAnisotropic > 0 then begin
5352 glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAniso);
5354 if Value > MaxAniso then
5355 fAnisotropic := MaxAniso;
5357 glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
5366 procedure TglBitmap.SetInternalFormat(const Value: TglBitmapInternalFormat);
5368 if InternalFormat <> Value then begin
5369 if FormatGetSize(Value) <> FormatGetSize(InternalFormat) then
5370 raise EglBitmapUnsupportedInternalFormat.Create('SetInternalFormat - ' + UNSUPPORTED_INTERNAL_FORMAT);
5373 SetDataPointer(Data, Value);
5378 function TglBitmap.AddFunc(Func: TglBitmapFunction; CreateTemp: Boolean;
5379 CustomData: Pointer): boolean;
5381 Result := AddFunc(Self, Func, CreateTemp, InternalFormat, CustomData);
5385 function TglBitmap.AddFunc(Source: TglBitmap; Func: TglBitmapFunction;
5386 CreateTemp: Boolean; Format: TglBitmapInternalFormat; CustomData: Pointer): boolean;
5388 pDest, NewImage, pSource: pByte;
5389 TempHeight, TempWidth: Integer;
5390 MapFunc: TglBitmapMapFunc;
5391 UnMapFunc: TglBitmapUnMapFunc;
5393 FuncRec: TglBitmapFunctionRec;
5395 Assert(Assigned(Data));
5396 Assert(Assigned(Source));
5397 Assert(Assigned(Source.Data));
5401 if Assigned (Source.Data) and FormatIsUncompressed(Format) and
5402 ((Source.Height > 0) or (Source.Width > 0)) then begin
5404 // inkompatible Formats so CreateTemp
5405 if FormatGetSize(Format) <> FormatGetSize(InternalFormat) then
5409 TempHeight := Max(1, Source.Height);
5410 TempWidth := Max(1, Source.Width);
5412 FuncRec.Sender := Self;
5413 FuncRec.CustomData := CustomData;
5417 if CreateTemp then begin
5418 GetMem(NewImage, Trunc(FormatGetSize(Format) * TempHeight * TempWidth));
5425 MapFunc := FormatGetMapFunc(Format);
5426 FormatPreparePixel(FuncRec.Dest, Format);
5427 FormatPreparePixel(FuncRec.Source, Source.InternalFormat);
5429 FuncRec.Size := Source.Dimension;
5430 FuncRec.Position.Fields := FuncRec.Size.Fields;
5432 if FormatIsUncompressed(Source.InternalFormat) then begin
5433 // Uncompressed Images
5434 pSource := Source.Data;
5435 UnMapFunc := FormatGetUnMapFunc(Source.InternalFormat);
5437 FuncRec.Position.Y := 0;
5438 while FuncRec.Position.Y < TempHeight do begin
5439 FuncRec.Position.X := 0;
5440 while FuncRec.Position.X < TempWidth do begin
5442 UnMapFunc(pSource, FuncRec.Source);
5446 MapFunc(FuncRec.Dest, pDest);
5447 Inc(FuncRec.Position.X);
5449 Inc(FuncRec.Position.Y);
5452 // Compressed Images
5453 FuncRec.Position.Y := 0;
5454 while FuncRec.Position.Y < TempHeight do begin
5455 FuncRec.Position.X := 0;
5456 while FuncRec.Position.X < TempWidth do begin
5458 fGetPixelFunc(FuncRec.Position, FuncRec.Source);
5462 MapFunc(FuncRec.Dest, pDest);
5463 Inc(FuncRec.Position.X);
5465 Inc(FuncRec.Position.Y);
5469 // Updating Image or InternalFormat
5471 SetDataPointer(NewImage, Format)
5474 if Format <> InternalFormat then
5475 SetInternalFormat(Format);
5480 then FreeMem(NewImage);
5487 procedure glBitmapConvertCopyFunc(var FuncRec: TglBitmapFunctionRec);
5489 with FuncRec do begin
5490 if Source.PixelDesc.RedRange > 0 then
5491 Dest.Red := Source.Red;
5493 if Source.PixelDesc.GreenRange > 0 then
5494 Dest.Green := Source.Green;
5496 if Source.PixelDesc.BlueRange > 0 then
5497 Dest.Blue := Source.Blue;
5499 if Source.PixelDesc.AlphaRange > 0 then
5500 Dest.Alpha := Source.Alpha;
5505 procedure glBitmapConvertCalculateRGBAFunc(var FuncRec: TglBitmapFunctionRec);
5507 with FuncRec do begin
5508 if Source.PixelDesc.RedRange > 0 then
5509 Dest.Red := Round(Dest.PixelDesc.RedRange * Source.Red / Source.PixelDesc.RedRange);
5511 if Source.PixelDesc.GreenRange > 0 then
5512 Dest.Green := Round(Dest.PixelDesc.GreenRange * Source.Green / Source.PixelDesc.GreenRange);
5514 if Source.PixelDesc.BlueRange > 0 then
5515 Dest.Blue := Round(Dest.PixelDesc.BlueRange * Source.Blue / Source.PixelDesc.BlueRange);
5517 if Source.PixelDesc.AlphaRange > 0 then
5518 Dest.Alpha := Round(Dest.PixelDesc.AlphaRange * Source.Alpha / Source.PixelDesc.AlphaRange);
5523 procedure glBitmapConvertShiftRGBAFunc(var FuncRec: TglBitmapFunctionRec);
5526 with TglBitmapPixelDesc(CustomData^) do begin
5527 if Source.PixelDesc.RedRange > 0 then
5528 Dest.Red := Source.Red shr RedShift;
5530 if Source.PixelDesc.GreenRange > 0 then
5531 Dest.Green := Source.Green shr GreenShift;
5533 if Source.PixelDesc.BlueRange > 0 then
5534 Dest.Blue := Source.Blue shr BlueShift;
5536 if Source.PixelDesc.AlphaRange > 0 then
5537 Dest.Alpha := Source.Alpha shr AlphaShift;
5542 function TglBitmap.ConvertTo(NewFormat: TglBitmapInternalFormat): boolean;
5544 Source, Dest: TglBitmapPixelData;
5545 PixelDesc: TglBitmapPixelDesc;
5547 function CopyDirect: Boolean;
5550 ((Source.PixelDesc.RedRange = Dest.PixelDesc.RedRange) or (Source.PixelDesc.RedRange = 0) or (Dest.PixelDesc.RedRange = 0)) and
5551 ((Source.PixelDesc.GreenRange = Dest.PixelDesc.GreenRange) or (Source.PixelDesc.GreenRange = 0) or (Dest.PixelDesc.GreenRange = 0)) and
5552 ((Source.PixelDesc.BlueRange = Dest.PixelDesc.BlueRange) or (Source.PixelDesc.BlueRange = 0) or (Dest.PixelDesc.BlueRange = 0)) and
5553 ((Source.PixelDesc.AlphaRange = Dest.PixelDesc.AlphaRange) or (Source.PixelDesc.AlphaRange = 0) or (Dest.PixelDesc.AlphaRange = 0));
5556 function CanShift: Boolean;
5559 ((Source.PixelDesc.RedRange >= Dest.PixelDesc.RedRange ) or (Source.PixelDesc.RedRange = 0) or (Dest.PixelDesc.RedRange = 0)) and
5560 ((Source.PixelDesc.GreenRange >= Dest.PixelDesc.GreenRange) or (Source.PixelDesc.GreenRange = 0) or (Dest.PixelDesc.GreenRange = 0)) and
5561 ((Source.PixelDesc.BlueRange >= Dest.PixelDesc.BlueRange ) or (Source.PixelDesc.BlueRange = 0) or (Dest.PixelDesc.BlueRange = 0)) and
5562 ((Source.PixelDesc.AlphaRange >= Dest.PixelDesc.AlphaRange) or (Source.PixelDesc.AlphaRange = 0) or (Dest.PixelDesc.AlphaRange = 0));
5565 function GetShift(Source, Dest: Cardinal) : ShortInt;
5569 while (Source > Dest) and (Source > 0) do begin
5571 Source := Source shr 1;
5576 if NewFormat <> InternalFormat then begin
5577 FormatPreparePixel(Source, InternalFormat);
5578 FormatPreparePixel(Dest, NewFormat);
5581 Result := AddFunc(Self, glBitmapConvertCopyFunc, False, NewFormat)
5583 if CanShift then begin
5584 PixelDesc.RedShift := GetShift(Source.PixelDesc.RedRange, Dest.PixelDesc.RedRange);
5585 PixelDesc.GreenShift := GetShift(Source.PixelDesc.GreenRange, Dest.PixelDesc.GreenRange);
5586 PixelDesc.BlueShift := GetShift(Source.PixelDesc.BlueRange, Dest.PixelDesc.BlueRange);
5587 PixelDesc.AlphaShift := GetShift(Source.PixelDesc.AlphaRange, Dest.PixelDesc.AlphaRange);
5589 Result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, False, NewFormat, @PixelDesc);
5591 else Result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, False, NewFormat);
5593 else Result := True;
5597 function TglBitmap.RemoveAlpha: Boolean;
5601 if (Assigned(Data)) then begin
5602 if not (FormatIsUncompressed(InternalFormat) or FormatHasAlpha(InternalFormat)) then
5603 raise EglBitmapUnsupportedInternalFormat.Create('RemoveAlpha - ' + UNSUPPORTED_INTERNAL_FORMAT);
5605 Result := ConvertTo(FormatGetWithoutAlpha(InternalFormat));
5610 function TglBitmap.AddAlphaFromFunc(Func: TglBitmapFunction; CustomData: Pointer): boolean;
5612 if not FormatIsUncompressed(InternalFormat) then
5613 raise EglBitmapUnsupportedInternalFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_INTERNAL_FORMAT);
5615 Result := AddFunc(Self, Func, False, FormatGetWithAlpha(InternalFormat), CustomData);
5619 function TglBitmap.GetHeight: Integer;
5621 if ffY in fDimension.Fields then
5622 Result := fDimension.Y
5628 function TglBitmap.GetWidth: Integer;
5630 if ffX in fDimension.Fields then
5631 Result := fDimension.X
5637 function TglBitmap.GetFileHeight: Integer;
5639 Result := Max(1, Height);
5643 function TglBitmap.GetFileWidth: Integer;
5645 Result := Max(1, Width);
5649 procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
5653 with FuncRec do begin
5655 Source.Red / Source.PixelDesc.RedRange * 0.3 +
5656 Source.Green / Source.PixelDesc.GreenRange * 0.59 +
5657 Source.Blue / Source.PixelDesc.BlueRange * 0.11;
5659 Dest.Alpha := Round (Dest.PixelDesc.AlphaRange * Temp);
5664 function TglBitmap.AddAlphaFromglBitmap(glBitmap: TglBitmap; Func: TglBitmapFunction; CustomData: Pointer): boolean;
5666 pDest, pDest2, pSource: pByte;
5667 TempHeight, TempWidth: Integer;
5668 MapFunc: TglBitmapMapFunc;
5669 DestUnMapFunc, UnMapFunc: TglBitmapUnMapFunc;
5671 FuncRec: TglBitmapFunctionRec;
5675 assert(Assigned(Data));
5676 assert(Assigned(glBitmap));
5677 assert(Assigned(glBitmap.Data));
5679 if ((glBitmap.Width = Width) and (glBitmap.Height = Height)) then begin
5680 // Convert to Data with Alpha
5681 Result := ConvertTo(FormatGetWithAlpha(FormatGetUncompressed(InternalFormat)));
5683 if not Assigned(Func) then
5684 Func := glBitmapAlphaFunc;
5687 TempHeight := glBitmap.FileHeight;
5688 TempWidth := glBitmap.FileWidth;
5690 FuncRec.Sender := Self;
5691 FuncRec.CustomData := CustomData;
5695 pSource := glBitmap.Data;
5698 FormatPreparePixel(FuncRec.Dest, InternalFormat);
5699 FormatPreparePixel(FuncRec.Source, glBitmap.InternalFormat);
5700 MapFunc := FormatGetMapFunc(InternalFormat);
5701 DestUnMapFunc := FormatGetUnMapFunc(InternalFormat);
5702 UnMapFunc := FormatGetUnMapFunc(glBitmap.InternalFormat);
5704 FuncRec.Size := Dimension;
5705 FuncRec.Position.Fields := FuncRec.Size.Fields;
5707 FuncRec.Position.Y := 0;
5708 while FuncRec.Position.Y < TempHeight do begin
5709 FuncRec.Position.X := 0;
5710 while FuncRec.Position.X < TempWidth do begin
5712 UnMapFunc(pSource, FuncRec.Source);
5713 DestUnMapFunc(pDest2, FuncRec.Dest);
5717 MapFunc(FuncRec.Dest, pDest);
5718 Inc(FuncRec.Position.X);
5720 Inc(FuncRec.Position.Y);
5726 procedure TglBitmap.SetBorderColor(Red, Green, Blue, Alpha: Single);
5728 fBorderColor[0] := Red;
5729 fBorderColor[1] := Green;
5730 fBorderColor[2] := Blue;
5731 fBorderColor[3] := Alpha;
5733 if ID > 0 then begin
5736 glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
5743 procedure TglBitmap2D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
5745 Idx, LineWidth: Integer;
5750 if FormatIsUncompressed(Format) then begin
5751 fUnmapFunc := FormatGetUnMapFunc(Format);
5752 fGetPixelFunc := GetPixel2DUnmap;
5754 fMapFunc := FormatGetMapFunc(Format);
5755 fSetPixelFunc := SetPixel2DUnmap;
5758 if Assigned(Data) then begin
5759 SetLength(fLines, GetHeight);
5761 LineWidth := Trunc(GetWidth * FormatGetSize(InternalFormat));
5763 for Idx := 0 to GetHeight -1 do begin
5764 fLines[Idx] := Data;
5765 Inc(fLines[Idx], Idx * LineWidth);
5768 else SetLength(fLines, 0);
5770 SetLength(fLines, 0);
5772 fSetPixelFunc := nil;
5776 fGetPixelFunc := GetPixel2DDXT1;
5778 fGetPixelFunc := GetPixel2DDXT3;
5780 fGetPixelFunc := GetPixel2DDXT5;
5782 fGetPixelFunc := nil;
5788 procedure TglBitmap2D.GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
5790 PDXT1Chunk = ^TDXT1Chunk;
5791 TDXT1Chunk = packed record
5794 Pixels: array [0..3] of byte;
5798 BasePtr: pDXT1Chunk;
5800 Colors: array [0..3] of TRGBQuad;
5802 BasePtr := pDXT1Chunk(pData);
5804 PixPos := BasePtr^.Pixels[relY] shr (relX * 2) and $3;
5806 if PixPos in [0, 2, 3] then begin
5807 Colors[0].rgbRed := BasePtr^.Color1 and $F800 shr 8;
5808 Colors[0].rgbGreen := BasePtr^.Color1 and $07E0 shr 3;
5809 Colors[0].rgbBlue := BasePtr^.Color1 and $001F shl 3;
5810 Colors[0].rgbReserved := 255;
5813 if PixPos in [1, 2, 3] then begin
5814 Colors[1].rgbRed := BasePtr^.Color2 and $F800 shr 8;
5815 Colors[1].rgbGreen := BasePtr^.Color2 and $07E0 shr 3;
5816 Colors[1].rgbBlue := BasePtr^.Color2 and $001F shl 3;
5817 Colors[1].rgbReserved := 255;
5820 if PixPos = 2 then begin
5821 Colors[2].rgbRed := (Colors[0].rgbRed * 67 + Colors[1].rgbRed * 33) div 100;
5822 Colors[2].rgbGreen := (Colors[0].rgbGreen * 67 + Colors[1].rgbGreen * 33) div 100;
5823 Colors[2].rgbBlue := (Colors[0].rgbBlue * 67 + Colors[1].rgbBlue * 33) div 100;
5824 Colors[2].rgbReserved := 255;
5827 if PixPos = 3 then begin
5828 Colors[3].rgbRed := (Colors[0].rgbRed * 33 + Colors[1].rgbRed * 67) div 100;
5829 Colors[3].rgbGreen := (Colors[0].rgbGreen * 33 + Colors[1].rgbGreen * 67) div 100;
5830 Colors[3].rgbBlue := (Colors[0].rgbBlue * 33 + Colors[1].rgbBlue * 67) div 100;
5831 if BasePtr^.Color1 > BasePtr^.Color2 then
5832 Colors[3].rgbReserved := 255
5834 Colors[3].rgbReserved := 0;
5837 Pixel.Red := Colors[PixPos].rgbRed;
5838 Pixel.Green := Colors[PixPos].rgbGreen;
5839 Pixel.Blue := Colors[PixPos].rgbBlue;
5840 Pixel.Alpha := Colors[PixPos].rgbReserved;
5844 procedure TglBitmap2D.GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
5847 PosX, PosY: Integer;
5851 if (Pos.Y <= Height) and (Pos.X <= Width) then begin
5852 PosX := Pos.X div 4;
5853 PosY := Pos.Y div 4;
5856 Inc(BasePtr, (PosY * Width div 4 + PosX) * 8);
5858 GetDXTColorBlock(BasePtr, Pos.X - PosX * 4, Pos.Y - PosY * 4, Pixel);
5863 procedure TglBitmap2D.GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
5865 PDXT3AlphaChunk = ^TDXT3AlphaChunk;
5866 TDXT3AlphaChunk = array [0..3] of WORD;
5870 AlphaPtr: PDXT3AlphaChunk;
5871 PosX, PosY, relX, relY: Integer;
5875 if (Pos.Y <= Height) and (Pos.X <= Width) then begin
5876 PosX := Pos.X div 4;
5877 PosY := Pos.Y div 4;
5878 relX := Pos.X - PosX * 4;
5879 relY := Pos.Y - PosY * 4;
5882 AlphaPtr := PDXT3AlphaChunk(Data);
5883 Inc(AlphaPtr, (PosY * Width div 4 + PosX) * 2);
5885 ColorPtr := pByte(AlphaPtr);
5888 GetDXTColorBlock(ColorPtr, relX, relY, Pixel);
5891 Pixel.Alpha := AlphaPtr^[relY] shr (4 * relX) and $0F shl 4;
5896 procedure TglBitmap2D.GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
5900 PixPos, PosX, PosY, relX, relY: Integer;
5901 Alpha0, Alpha1: Byte;
5905 if (Pos.Y <= Height) and (Pos.X <= Width) then begin
5906 PosX := Pos.X div 4;
5907 PosY := Pos.Y div 4;
5908 relX := Pos.X - PosX * 4;
5909 relY := Pos.Y - PosY * 4;
5912 AlphaPtr := PInt64(Data);
5913 Inc(AlphaPtr, (PosY * Width div 4 + PosX) * 2);
5915 ColorPtr := pByte(AlphaPtr);
5918 GetDXTColorBlock(ColorPtr, relX, relY, Pixel);
5921 Alpha0 := AlphaPtr^ and $FF;
5922 Alpha1 := AlphaPtr^ shr 8 and $FF;
5924 PixPos := AlphaPtr^ shr (16 + (relY * 4 + relX) * 3) and $07;
5927 if PixPos = 0 then begin
5928 Pixel.Alpha := Alpha0;
5932 if PixPos = 1 then begin
5933 Pixel.Alpha := Alpha1;
5936 // alpha interpolate 7 Steps
5937 if Alpha0 > Alpha1 then begin
5938 Pixel.Alpha := ((8 - PixPos) * Alpha0 + (PixPos - 1) * Alpha1) div 7;
5941 // alpha is 100% transparent or not transparent
5942 if PixPos >= 6 then begin
5949 // alpha interpolate 5 Steps
5951 Pixel.Alpha := ((6 - PixPos) * Alpha0 + (PixPos - 1) * Alpha1) div 5;
5957 procedure TglBitmap2D.GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
5961 pTemp := fLines[Pos.Y];
5962 Inc(pTemp, Pos.X * fPixelSize);
5964 fUnmapFunc(pTemp, Pixel);
5968 procedure TglBitmap2D.SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
5972 pTemp := fLines[Pos.Y];
5973 Inc(pTemp, Pos.X * fPixelSize);
5975 fMapFunc(Pixel, pTemp);
5979 function TglBitmap2D.FlipHorz: Boolean;
5982 pTempDest, pDest, pSource: pByte;
5985 Result := Inherited FlipHorz;
5987 if Assigned(Data) then begin
5989 ImgSize := Height * fRowSize;
5991 GetMem(pDest, ImgSize);
5995 Dec(pTempDest, fRowSize + fPixelSize);
5996 for Row := 0 to Height -1 do begin
5997 Inc(pTempDest, fRowSize * 2);
5998 for Col := 0 to Width -1 do begin
5999 Move(pSource^, pTempDest^, fPixelSize);
6001 Inc(pSource, fPixelSize);
6002 Dec(pTempDest, fPixelSize);
6006 SetDataPointer(pDest, InternalFormat);
6017 function TglBitmap2D.FlipVert: Boolean;
6020 pTempDest, pDest, pSource: pByte;
6022 Result := Inherited FlipVert;
6024 if Assigned(Data) then begin
6026 GetMem(pDest, Height * fRowSize);
6030 Inc(pTempDest, Width * (Height -1) * fPixelSize);
6032 for Row := 0 to Height -1 do begin
6033 Move(pSource^, pTempDest^, fRowSize);
6035 Dec(pTempDest, fRowSize);
6036 Inc(pSource, fRowSize);
6039 SetDataPointer(pDest, InternalFormat);
6050 procedure TglBitmap2D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
6052 glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
6055 if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
6056 glCompressedTexImage2D(Target, 0, InternalFormat, Width, Height, 0, Trunc(Width * Height * FormatGetSize(Self.InternalFormat)), Data)
6059 if BuildWithGlu then
6060 gluBuild2DMipmaps(Target, InternalFormat, Width, Height, Format, Typ, Data)
6062 glTexImage2D(Target, 0, InternalFormat, Width, Height, 0, Format, Typ, Data);
6065 if (FreeDataAfterGenTexture) then
6070 procedure TglBitmap2D.GenTexture(TestTextureSize: Boolean);
6072 BuildWithGlu, PotTex, TexRec: Boolean;
6073 glFormat, glInternalFormat, glType: Cardinal;
6076 if Assigned(Data) then begin
6077 // Check Texture Size
6078 if (TestTextureSize) then begin
6079 glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
6081 if ((Height > TexSize) or (Width > TexSize)) then
6082 raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
6084 PotTex := IsPowerOfTwo (Height) and IsPowerOfTwo (Width);
6085 TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
6086 (Target = GL_TEXTURE_RECTANGLE_ARB);
6088 if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
6089 raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
6094 SetupParameters(BuildWithGlu);
6095 SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
6097 UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
6100 glAreTexturesResident(1, @ID, @fIsResident);
6105 procedure TglBitmap2D.AfterConstruction;
6109 Target := GL_TEXTURE_2D;
6114 TMatrixItem = record
6119 PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
6120 TglBitmapToNormalMapRec = Record
6122 Heights: array of Single;
6123 MatrixU : array of TMatrixItem;
6124 MatrixV : array of TMatrixItem;
6128 oneover255 = 1 / 255;
6130 procedure glBitmapToNormalMapPrepareFunc (var FuncRec: TglBitmapFunctionRec);
6134 with FuncRec do begin
6135 Val := Source.Red * 0.3 + Source.Green * 0.59 + Source.Blue * 0.11;
6136 PglBitmapToNormalMapRec (CustomData)^.Heights[Position.Y * Size.X + Position.X] := Val * oneover255;
6141 procedure glBitmapToNormalMapPrepareAlphaFunc (var FuncRec: TglBitmapFunctionRec);
6144 PglBitmapToNormalMapRec (CustomData)^.Heights[Position.Y * Size.X + Position.X] := Source.Alpha * oneover255;
6148 procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
6150 TVec = Array[0..2] of Single;
6157 function GetHeight(X, Y: Integer): Single;
6159 with FuncRec do begin
6160 X := Max(0, Min(Size.X -1, X));
6161 Y := Max(0, Min(Size.Y -1, Y));
6163 Result := PglBitmapToNormalMapRec (CustomData)^.Heights[Y * Size.X + X];
6168 with FuncRec do begin
6169 with PglBitmapToNormalMapRec (CustomData)^ do begin
6171 for Idx := Low(MatrixU) to High(MatrixU) do
6172 du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
6175 for Idx := Low(MatrixU) to High(MatrixU) do
6176 dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
6178 Vec[0] := -du * Scale;
6179 Vec[1] := -dv * Scale;
6184 Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
6185 if Len <> 0 then begin
6186 Vec[0] := Vec[0] * Len;
6187 Vec[1] := Vec[1] * Len;
6188 Vec[2] := Vec[2] * Len;
6192 Dest.Red := Trunc((Vec[0] + 1) * 127.5);
6193 Dest.Green := Trunc((Vec[1] + 1) * 127.5);
6194 Dest.Blue := Trunc((Vec[2] + 1) * 127.5);
6199 procedure TglBitmap2D.ToNormalMap(Func: TglBitmapNormalMapFunc; Scale: Single; UseAlpha: Boolean);
6201 Rec: TglBitmapToNormalMapRec;
6203 procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
6205 if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
6206 Matrix[Index].X := X;
6207 Matrix[Index].Y := Y;
6208 Matrix[Index].W := W;
6213 if not FormatIsUncompressed(InternalFormat) then
6214 raise EglBitmapUnsupportedInternalFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_INTERNAL_FORMAT);
6219 if Scale < -100 then
6224 SetLength(Rec.Heights, Width * Height);
6229 SetLength(Rec.MatrixU, 2);
6230 SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
6231 SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
6233 SetLength(Rec.MatrixV, 2);
6234 SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
6235 SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
6239 SetLength(Rec.MatrixU, 6);
6240 SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
6241 SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
6242 SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
6243 SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
6244 SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
6245 SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
6247 SetLength(Rec.MatrixV, 6);
6248 SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
6249 SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
6250 SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
6251 SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
6252 SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
6253 SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
6257 SetLength(Rec.MatrixU, 6);
6258 SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
6259 SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
6260 SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
6261 SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
6262 SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
6263 SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
6265 SetLength(Rec.MatrixV, 6);
6266 SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
6267 SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
6268 SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
6269 SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
6270 SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
6271 SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
6275 SetLength(Rec.MatrixU, 20);
6276 SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
6277 SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
6278 SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
6279 SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
6280 SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
6281 SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
6282 SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
6283 SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
6284 SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
6285 SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
6286 SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
6287 SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
6288 SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
6289 SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
6290 SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
6291 SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
6292 SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
6293 SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
6294 SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
6295 SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
6297 SetLength(Rec.MatrixV, 20);
6298 SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
6299 SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
6300 SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
6301 SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
6302 SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
6303 SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
6304 SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
6305 SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
6306 SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
6307 SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
6308 SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
6309 SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
6310 SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
6311 SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
6312 SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
6313 SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
6314 SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
6315 SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
6316 SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
6317 SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
6322 if UseAlpha and FormatHasAlpha(InternalFormat) then
6323 AddFunc(glBitmapToNormalMapPrepareAlphaFunc, False, @Rec)
6325 AddFunc(glBitmapToNormalMapPrepareFunc, False, @Rec);
6327 // Neues Bild berechnen
6328 AddFunc(glBitmapToNormalMapFunc, False, @Rec);
6330 SetLength(Rec.Heights, 0);
6335 procedure TglBitmap2D.GrabScreen(Top, Left, Right, Bottom: Integer; Format: TglBitmapInternalFormat);
6339 glFormat, glInternalFormat, glType: Cardinal;
6341 if not FormatIsUncompressed(Format) then
6342 raise EglBitmapUnsupportedInternalFormat.Create('TglBitmap2D.GrabScreen - ' + UNSUPPORTED_INTERNAL_FORMAT);
6344 // Only to select Formats
6345 SelectFormat(Format, glFormat, glInternalFormat, glType, False);
6347 Size := FormatGetImageSize(glBitmapPosition(Right - Left, Bottom - Top), Format);
6350 glPixelStorei(GL_PACK_ALIGNMENT, 1);
6351 glReadPixels(Left, Top, Right - Left, Bottom - Top, glFormat, glType, Temp);
6354 SetDataPointer(Temp, Format, Right - Left, Bottom - Top);
6365 procedure TglBitmap2D.GetDataFromTexture;
6368 TempWidth, TempHeight, RedSize, GreenSize, BlueSize, AlphaSize, LumSize: Integer;
6369 TempType, TempIntFormat: Cardinal;
6370 IntFormat: TglBitmapInternalFormat;
6375 glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
6376 glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
6377 glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
6379 glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_RED_SIZE, @RedSize);
6380 glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_GREEN_SIZE, @GreenSize);
6381 glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_BLUE_SIZE, @BlueSize);
6382 glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_ALPHA_SIZE, @AlphaSize);
6383 glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_LUMINANCE_SIZE, @LumSize);
6385 // Get glBitmapInternalFormat from TempIntFormat
6386 TempType := GL_UNSIGNED_BYTE;
6387 case TempIntFormat of
6389 IntFormat := ifAlpha;
6391 IntFormat := ifLuminance;
6393 IntFormat := ifLuminanceAlpha;
6396 IntFormat := ifR5G6B5;
6397 TempIntFormat := GL_RGB;
6398 TempType := GL_UNSIGNED_SHORT_5_6_5;
6401 IntFormat := ifRGB8;
6402 GL_RGBA, GL_RGBA4, GL_RGBA8:
6404 if (RedSize = 4) and (BlueSize = 4) and (GreenSize = 4) and (AlphaSize = 4) then begin
6405 IntFormat := ifRGBA4;
6406 TempIntFormat := GL_BGRA;
6407 TempType := GL_UNSIGNED_SHORT_4_4_4_4_REV;
6409 if (RedSize = 5) and (BlueSize = 5) and (GreenSize = 5) and (AlphaSize = 1) then begin
6410 IntFormat := ifRGB5A1;
6411 TempIntFormat := GL_BGRA;
6412 TempType := GL_UNSIGNED_SHORT_1_5_5_5_REV;
6414 IntFormat := ifRGBA8;
6418 IntFormat := ifBGR8;
6420 IntFormat := ifBGRA8;
6421 GL_COMPRESSED_RGB_S3TC_DXT1_EXT:
6422 IntFormat := ifDXT1;
6423 GL_COMPRESSED_RGBA_S3TC_DXT1_EXT:
6424 IntFormat := ifDXT1;
6425 GL_COMPRESSED_RGBA_S3TC_DXT3_EXT:
6426 IntFormat := ifDXT3;
6427 GL_COMPRESSED_RGBA_S3TC_DXT5_EXT:
6428 IntFormat := ifDXT5;
6430 IntFormat := ifEmpty;
6433 // Getting data from OpenGL
6434 GetMem(Temp, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
6436 if FormatIsCompressed(IntFormat) and (GL_VERSION_1_3 or GL_ARB_texture_compression) then
6437 glGetCompressedTexImage(Target, 0, Temp)
6439 glGetTexImage(Target, 0, TempIntFormat, TempType, Temp);
6441 SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
6449 function TglBitmap2D.GetScanline(Index: Integer): Pointer;
6451 if (Index >= Low(fLines)) and (Index <= High(fLines)) then
6452 Result := fLines[Index]
6460 procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
6465 if Height > 1 then begin
6466 // extract first line of the data
6467 Size := FormatGetImageSize(glBitmapPosition(Width), Format);
6468 GetMem(pTemp, Size);
6470 Move(Data^, pTemp^, Size);
6477 inherited SetDataPointer(pTemp, Format, Width);
6479 if FormatIsUncompressed(Format) then begin
6480 fUnmapFunc := FormatGetUnMapFunc(Format);
6481 fGetPixelFunc := GetPixel1DUnmap;
6486 procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
6491 Inc(pTemp, Pos.X * fPixelSize);
6493 fUnmapFunc(pTemp, Pixel);
6497 function TglBitmap1D.FlipHorz: Boolean;
6500 pTempDest, pDest, pSource: pByte;
6502 Result := Inherited FlipHorz;
6504 if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
6507 GetMem(pDest, fRowSize);
6511 Inc(pTempDest, fRowSize);
6512 for Col := 0 to Width -1 do begin
6513 Move(pSource^, pTempDest^, fPixelSize);
6515 Inc(pSource, fPixelSize);
6516 Dec(pTempDest, fPixelSize);
6519 SetDataPointer(pDest, InternalFormat);
6529 procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
6532 if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
6533 glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
6537 if BuildWithGlu then
6538 gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
6540 glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
6543 if (FreeDataAfterGenTexture) then
6548 procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
6550 BuildWithGlu, TexRec: Boolean;
6551 glFormat, glInternalFormat, glType: Cardinal;
6554 if Assigned(Data) then begin
6555 // Check Texture Size
6556 if (TestTextureSize) then begin
6557 glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
6559 if (Width > TexSize) then
6560 raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
6562 TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
6563 (Target = GL_TEXTURE_RECTANGLE_ARB);
6565 if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
6566 raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
6571 SetupParameters(BuildWithGlu);
6572 SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
6574 UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
6577 glAreTexturesResident(1, @ID, @fIsResident);
6582 procedure TglBitmap1D.AfterConstruction;
6586 Target := GL_TEXTURE_1D;
6590 { TglBitmapCubeMap }
6592 procedure TglBitmapCubeMap.AfterConstruction;
6596 if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
6597 raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
6599 SetWrap; // set all to GL_CLAMP_TO_EDGE
6600 Target := GL_TEXTURE_CUBE_MAP;
6601 fGenMode := GL_REFLECTION_MAP;
6605 procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
6607 inherited Bind (EnableTextureUnit);
6609 if EnableTexCoordsGen then begin
6610 glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
6611 glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
6612 glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
6613 glEnable(GL_TEXTURE_GEN_S);
6614 glEnable(GL_TEXTURE_GEN_T);
6615 glEnable(GL_TEXTURE_GEN_R);
6620 procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
6622 glFormat, glInternalFormat, glType: Cardinal;
6623 BuildWithGlu: Boolean;
6626 // Check Texture Size
6627 if (TestTextureSize) then begin
6628 glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
6630 if ((Height > TexSize) or (Width > TexSize)) then
6631 raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
6633 if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
6634 raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
6638 if ID = 0 then begin
6640 SetupParameters(BuildWithGlu);
6643 SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
6645 UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
6649 procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
6651 Assert(False, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
6655 procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
6656 DisableTextureUnit: Boolean);
6658 inherited Unbind (DisableTextureUnit);
6660 if DisableTexCoordsGen then begin
6661 glDisable(GL_TEXTURE_GEN_S);
6662 glDisable(GL_TEXTURE_GEN_T);
6663 glDisable(GL_TEXTURE_GEN_R);
6668 { TglBitmapNormalMap }
6671 TVec = Array[0..2] of Single;
6672 TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6674 PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
6675 TglBitmapNormalMapRec = record
6677 Func: TglBitmapNormalMapGetVectorFunc;
6681 procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6684 Vec[1] := - (Position.Y + 0.5 - HalfSize);
6685 Vec[2] := - (Position.X + 0.5 - HalfSize);
6689 procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6691 Vec[0] := - HalfSize;
6692 Vec[1] := - (Position.Y + 0.5 - HalfSize);
6693 Vec[2] := Position.X + 0.5 - HalfSize;
6697 procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6699 Vec[0] := Position.X + 0.5 - HalfSize;
6701 Vec[2] := Position.Y + 0.5 - HalfSize;
6705 procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6707 Vec[0] := Position.X + 0.5 - HalfSize;
6708 Vec[1] := - HalfSize;
6709 Vec[2] := - (Position.Y + 0.5 - HalfSize);
6713 procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6715 Vec[0] := Position.X + 0.5 - HalfSize;
6716 Vec[1] := - (Position.Y + 0.5 - HalfSize);
6721 procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
6723 Vec[0] := - (Position.X + 0.5 - HalfSize);
6724 Vec[1] := - (Position.Y + 0.5 - HalfSize);
6725 Vec[2] := - HalfSize;
6729 procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
6734 with FuncRec do begin
6735 with PglBitmapNormalMapRec (CustomData)^ do begin
6736 Func(Vec, Position, HalfSize);
6739 Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
6740 if Len <> 0 then begin
6741 Vec[0] := Vec[0] * Len;
6742 Vec[1] := Vec[1] * Len;
6743 Vec[2] := Vec[2] * Len;
6746 // Scale Vector and AddVectro
6747 Vec[0] := Vec[0] * 0.5 + 0.5;
6748 Vec[1] := Vec[1] * 0.5 + 0.5;
6749 Vec[2] := Vec[2] * 0.5 + 0.5;
6753 Dest.Red := Round(Vec[0] * 255);
6754 Dest.Green := Round(Vec[1] * 255);
6755 Dest.Blue := Round(Vec[2] * 255);
6760 procedure TglBitmapNormalMap.AfterConstruction;
6764 fGenMode := GL_NORMAL_MAP;
6768 procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
6769 TestTextureSize: Boolean);
6771 Rec: TglBitmapNormalMapRec;
6772 SizeRec: TglBitmapPixelPosition;
6774 Rec.HalfSize := Size div 2;
6776 FreeDataAfterGenTexture := False;
6778 SizeRec.Fields := [ffX, ffY];
6783 Rec.Func := glBitmapNormalMapPosX;
6784 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6785 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
6788 Rec.Func := glBitmapNormalMapNegX;
6789 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6790 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
6793 Rec.Func := glBitmapNormalMapPosY;
6794 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6795 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
6798 Rec.Func := glBitmapNormalMapNegY;
6799 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6800 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
6803 Rec.Func := glBitmapNormalMapPosZ;
6804 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6805 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
6808 Rec.Func := glBitmapNormalMapNegZ;
6809 LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
6810 GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
6816 glBitmapSetDefaultFormat(tfDefault);
6817 glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
6818 glBitmapSetDefaultWrap(GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
6820 glBitmapSetDefaultFreeDataAfterGenTexture(True);
6821 glBitmapSetDefaultDeleteTextureOnFree(True);