{ $Id: ImagingOpenGL.pas 165 2009-08-14 12:34:40Z galfar $ Vampyre Imaging Library by Marek Mauder http://imaginglib.sourceforge.net The contents of this file are used with permission, subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/MPL-1.1.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. Alternatively, the contents of this file may be used under the terms of the GNU Lesser General Public License (the "LGPL License"), in which case the provisions of the LGPL License are applicable instead of those above. If you wish to allow use of your version of this file only under the terms of the LGPL License and not to allow others to use your version of this file under the MPL, indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the LGPL License. If you do not delete the provisions above, a recipient may use your version of this file under either the MPL or the LGPL License. For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html } { This unit contains functions for loading and saving OpenGL textures using Imaging and for converting images to textures and vice versa.} unit ImagingOpenGL; {$I ImagingOptions.inc} { Define this symbol if you want to use dglOpenGL header.} { $DEFINE USE_DGL_HEADERS} { $DEFINE USE_GLSCENE_HEADERS} interface uses SysUtils, Classes, ImagingTypes, Imaging, ImagingFormats, {$IF Defined(USE_DGL_HEADERS)} dglOpenGL, {$ELSEIF Defined(USE_GLSCENE_HEADERS)} OpenGL1x, {$ELSE} gl, glext, {$IFEND} ImagingUtility; type { Various texture capabilities of installed OpenGL driver.} TGLTextureCaps = record MaxTextureSize: LongInt; // Max size of texture in pixels supported by HW NonPowerOfTwo: Boolean; // HW has full support for NPOT textures DXTCompression: Boolean; // HW supports S3TC/DXTC compressed textures ATI3DcCompression: Boolean; // HW supports ATI 3Dc compressed textures (ATI2N) LATCCompression: Boolean; // HW supports LATC/RGTC compressed textures (ATI1N+ATI2N) FloatTextures: Boolean; // HW supports floating point textures MaxAnisotropy: LongInt; // Max anisotropy for aniso texture filtering MaxSimultaneousTextures: LongInt; // Number of texture units ClampToEdge: Boolean; // GL_EXT_texture_edge_clamp TextureLOD: Boolean; // GL_SGIS_texture_lod VertexTextureUnits: Integer; // Texture units accessible in vertex programs end; { Returns texture capabilities of installed OpenGL driver.} function GetGLTextureCaps(var Caps: TGLTextureCaps): Boolean; { Function which can be used to retrieve GL extension functions.} function GetGLProcAddress(const ProcName: string): Pointer; { Returns True if the given GL extension is supported.} function IsGLExtensionSupported(const Extension: string): Boolean; { Returns True if the given image format can be represented as GL texture format. GLFormat, GLType, and GLInternal are parameters for functions like glTexImage. Note that GLU functions like gluBuildMipmaps cannot handle some formats returned by this function (i.e. GL_UNSIGNED_SHORT_5_5_5_1 as GLType). If you are using compressed or floating-point images make sure that they are supported by hardware using GetGLTextureCaps, ImageFormatToGL does not check this.} function ImageFormatToGL(Format: TImageFormat; var GLFormat: GLenum; var GLType: GLenum; var GLInternal: GLint; const Caps: TGLTextureCaps): Boolean; { All GL textures created by Imaging functions have default parameters set - that means that no glTexParameter calls are made so default filtering, wrapping, and other parameters are used. Created textures are left bound by glBindTexture when function is exited.} { Creates GL texture from image in file in format supported by Imaging. You can use CreatedWidth and Height parameters to query dimensions of created textures (it could differ from dimensions of source image).} function LoadGLTextureFromFile(const FileName: string; CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): GLuint; { Creates GL texture from image in stream in format supported by Imaging. You can use CreatedWidth and Height parameters to query dimensions of created textures (it could differ from dimensions of source image).} function LoadGLTextureFromStream(Stream: TStream; CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): GLuint; { Creates GL texture from image in memory in format supported by Imaging. You can use CreatedWidth and Height parameters to query dimensions of created textures (it could differ from dimensions of source image).} function LoadGLTextureFromMemory(Data: Pointer; Size: LongInt; CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): GLuint; { Converts TImageData structure to OpenGL texture. Input images is used as main mipmap level and additional requested levels are generated from this one. For the details on parameters look at CreateGLTextureFromMultiImage function.} function CreateGLTextureFromImage(const Image: TImageData; Width: LongInt = 0; Height: LongInt = 0; MipMaps: Boolean = True; OverrideFormat: TImageFormat = ifUnknown; CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): GLuint; { Converts images in TDymImageDataArray to one OpenGL texture. Image at index MainLevelIndex in the array is used as main mipmap level and additional images are used as subsequent levels. If there is not enough images in array missing levels are automatically generated (and if there is enough images but they have wrong dimensions or format then they are resized/converted). If driver supports only power of two sized textures images are resized. OverrideFormat can be used to convert image into specific format before it is passed to OpenGL, ifUnknown means no conversion. If desired texture format is not supported by hardware default A8R8G8B8 format is used instead for color images and ifGray8 is used for luminance images. DXTC (S3TC) compressed and floating point textures are created if supported by hardware. Width and Height can be used to set size of main mipmap level according to your needs, Width and Height of 0 mean use width and height of input image that will become main level mipmap. MipMaps set to True mean build all possible levels, False means use only level 0. You can use CreatedWidth and CreatedHeight parameters to query dimensions of created texture's largest mipmap level (it could differ from dimensions of source image).} function CreateGLTextureFromMultiImage(const Images: TDynImageDataArray; Width: LongInt = 0; Height: LongInt = 0; MipMaps: Boolean = True; MainLevelIndex: LongInt = 0; OverrideFormat: TImageFormat = ifUnknown; CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): GLuint; { Saves GL texture to file in one of formats supported by Imaging. Saves all present mipmap levels.} function SaveGLTextureToFile(const FileName: string; const Texture: GLuint): Boolean; { Saves GL texture to stream in one of formats supported by Imaging. Saves all present mipmap levels.} function SaveGLTextureToStream(const Ext: string; Stream: TStream; const Texture: GLuint): Boolean; { Saves GL texture to memory in one of formats supported by Imaging. Saves all present mipmap levels.} function SaveGLTextureToMemory(const Ext: string; Data: Pointer; var Size: LongInt; const Texture: GLuint): Boolean; { Converts main level of the GL texture to TImageData strucrue. OverrideFormat can be used to convert output image to the specified format rather than use the format taken from GL texture, ifUnknown means no conversion.} function CreateImageFromGLTexture(const Texture: GLuint; var Image: TImageData; OverrideFormat: TImageFormat = ifUnknown): Boolean; { Converts GL texture to TDynImageDataArray array of images. You can specify how many mipmap levels of the input texture you want to be converted (default is all levels). OverrideFormat can be used to convert output images to the specified format rather than use the format taken from GL texture, ifUnknown means no conversion.} function CreateMultiImageFromGLTexture(const Texture: GLuint; var Images: TDynImageDataArray; MipLevels: LongInt = 0; OverrideFormat: TImageFormat = ifUnknown): Boolean; var { Standard behaviour of image->texture functions like CreateGLTextureFrom(Multi)Image is: If graphic card supports non power of 2 textures and image is nonpow2 then texture is created directly from image. If graphic card does not support them input image is rescaled (bilinear) to power of 2 size. If you set PasteNonPow2ImagesIntoPow2 to True then instead of rescaling, a new pow2 texture is created and nonpow2 input image is pasted into it keeping its original size. This could be useful for some 2D stuff (and its faster than rescaling of course). Note that this is applied to all rescaling smaller->bigger operations that might ocurr during image->texture process (usually only pow2/nonpow2 stuff and when you set custom Width & Height in CreateGLTextureFrom(Multi)Image).} PasteNonPow2ImagesIntoPow2: Boolean = False; { Standard behaviur if GL_ARB_texture_non_power_of_two extension is not supported is to rescale image to power of 2 dimensions. NPOT extension is exposed only when HW has full support for NPOT textures but some cards (ATI Radeons, some other maybe) have partial NPOT support. Namely Radeons can use NPOT textures but not mipmapped. If you know what you are doing you can disable NPOT support check so the image won't be rescaled to POT by seting DisableNPOTSupportCheck to True.} DisableNPOTSupportCheck: Boolean = False; implementation const // cube map consts GL_TEXTURE_BINDING_CUBE_MAP = $8514; GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515; GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516; GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517; GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518; GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519; GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A; // texture formats GL_COLOR_INDEX = $1900; GL_STENCIL_INDEX = $1901; GL_DEPTH_COMPONENT = $1902; GL_RED = $1903; GL_GREEN = $1904; GL_BLUE = $1905; GL_ALPHA = $1906; GL_RGB = $1907; GL_RGBA = $1908; GL_LUMINANCE = $1909; GL_LUMINANCE_ALPHA = $190A; GL_BGR_EXT = $80E0; GL_BGRA_EXT = $80E1; // texture internal formats GL_ALPHA4 = $803B; GL_ALPHA8 = $803C; GL_ALPHA12 = $803D; GL_ALPHA16 = $803E; GL_LUMINANCE4 = $803F; GL_LUMINANCE8 = $8040; GL_LUMINANCE12 = $8041; GL_LUMINANCE16 = $8042; GL_LUMINANCE4_ALPHA4 = $8043; GL_LUMINANCE6_ALPHA2 = $8044; GL_LUMINANCE8_ALPHA8 = $8045; GL_LUMINANCE12_ALPHA4 = $8046; GL_LUMINANCE12_ALPHA12 = $8047; GL_LUMINANCE16_ALPHA16 = $8048; GL_INTENSITY = $8049; GL_INTENSITY4 = $804A; GL_INTENSITY8 = $804B; GL_INTENSITY12 = $804C; GL_INTENSITY16 = $804D; GL_R3_G3_B2 = $2A10; GL_RGB4 = $804F; GL_RGB5 = $8050; GL_RGB8 = $8051; GL_RGB10 = $8052; GL_RGB12 = $8053; GL_RGB16 = $8054; GL_RGBA2 = $8055; GL_RGBA4 = $8056; GL_RGB5_A1 = $8057; GL_RGBA8 = $8058; GL_RGB10_A2 = $8059; GL_RGBA12 = $805A; GL_RGBA16 = $805B; // floating point texture formats GL_RGBA32F_ARB = $8814; GL_INTENSITY32F_ARB = $8817; GL_LUMINANCE32F_ARB = $8818; GL_RGBA16F_ARB = $881A; GL_INTENSITY16F_ARB = $881D; GL_LUMINANCE16F_ARB = $881E; // compressed texture formats GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1; GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2; GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3; GL_COMPRESSED_LUMINANCE_ALPHA_3DC_ATI = $8837; GL_COMPRESSED_LUMINANCE_LATC1_EXT = $8C70; GL_COMPRESSED_SIGNED_LUMINANCE_LATC1_EXT = $8C71; GL_COMPRESSED_LUMINANCE_ALPHA_LATC2_EXT = $8C72; GL_COMPRESSED_SIGNED_LUMINANCE_ALPHA_LATC2_EXT = $8C73; // various GL extension constants GL_MAX_TEXTURE_UNITS = $84E2; GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE; GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF; // texture source data formats GL_UNSIGNED_BYTE_3_3_2 = $8032; GL_UNSIGNED_SHORT_4_4_4_4 = $8033; GL_UNSIGNED_SHORT_5_5_5_1 = $8034; GL_UNSIGNED_INT_8_8_8_8 = $8035; GL_UNSIGNED_INT_10_10_10_2 = $8036; GL_UNSIGNED_BYTE_2_3_3_REV = $8362; GL_UNSIGNED_SHORT_5_6_5 = $8363; GL_UNSIGNED_SHORT_5_6_5_REV = $8364; GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365; GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366; GL_UNSIGNED_INT_8_8_8_8_REV = $8367; GL_UNSIGNED_INT_2_10_10_10_REV = $8368; GL_HALF_FLOAT_ARB = $140B; // Other GL constants GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS = $8B4C; {$IFDEF MSWINDOWS} GLLibName = 'opengl32.dll'; {$ENDIF} {$IFDEF UNIX} GLLibName = 'libGL.so'; {$ENDIF} type TglCompressedTexImage2D = procedure (Target: GLenum; Level: GLint; InternalFormat: GLenum; Width: GLsizei; Height: GLsizei; Border: GLint; ImageSize: GLsizei; const Data: PGLvoid); {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} var glCompressedTexImage2D: TglCompressedTexImage2D = nil; ExtensionBuffer: string = ''; {$IFDEF MSWINDOWS} function wglGetProcAddress(ProcName: PChar): Pointer; stdcall; external GLLibName; {$ENDIF} {$IFDEF UNIX} function glXGetProcAddress(ProcName: PChar): Pointer; cdecl; external GLLibName; {$ENDIF} function IsGLExtensionSupported(const Extension: string): Boolean; var ExtPos: LongInt; begin if ExtensionBuffer = '' then ExtensionBuffer := glGetString(GL_EXTENSIONS); ExtPos := Pos(Extension, ExtensionBuffer); Result := ExtPos > 0; if Result then begin Result := ((ExtPos + Length(Extension) - 1) = Length(ExtensionBuffer)) or not (ExtensionBuffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']); end; end; function GetGLProcAddress(const ProcName: string): Pointer; begin {$IFDEF MSWINDOWS} Result := wglGetProcAddress(PChar(ProcName)); {$ENDIF} {$IFDEF UNIX} Result := glXGetProcAddress(PChar(ProcName)); {$ENDIF} end; function GetGLTextureCaps(var Caps: TGLTextureCaps): Boolean; begin // Check DXTC support and load extension functions if necesary Caps.DXTCompression := IsGLExtensionSupported('GL_ARB_texture_compression') and IsGLExtensionSupported('GL_EXT_texture_compression_s3tc'); if Caps.DXTCompression then glCompressedTexImage2D := GetGLProcAddress('glCompressedTexImage2D'); Caps.DXTCompression := Caps.DXTCompression and (@glCompressedTexImage2D <> nil); Caps.ATI3DcCompression := Caps.DXTCompression and IsGLExtensionSupported('GL_ATI_texture_compression_3dc'); Caps.LATCCompression := Caps.DXTCompression and IsGLExtensionSupported('GL_EXT_texture_compression_latc'); // Check non power of 2 textures Caps.NonPowerOfTwo := IsGLExtensionSupported('GL_ARB_texture_non_power_of_two'); // Check for floating point textures support Caps.FloatTextures := IsGLExtensionSupported('GL_ARB_texture_float'); // Get max texture size glGetIntegerv(GL_MAX_TEXTURE_SIZE, @Caps.MaxTextureSize); // Get max anisotropy if IsGLExtensionSupported('GL_EXT_texture_filter_anisotropic') then glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @Caps.MaxAnisotropy) else Caps.MaxAnisotropy := 0; // Get number of texture units if IsGLExtensionSupported('GL_ARB_multitexture') then glGetIntegerv(GL_MAX_TEXTURE_UNITS, @Caps.MaxSimultaneousTextures) else Caps.MaxSimultaneousTextures := 1; // Get number of vertex texture units if IsGLExtensionSupported('GL_ARB_vertex_shader') then glGetIntegerv(GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS, @Caps.VertexTextureUnits) else Caps.VertexTextureUnits := 1; // Get max texture size glGetIntegerv(GL_MAX_TEXTURE_SIZE, @Caps.MaxTextureSize); // Clamp texture to edge? Caps.ClampToEdge := IsGLExtensionSupported('GL_EXT_texture_edge_clamp'); // Texture LOD extension? Caps.TextureLOD := IsGLExtensionSupported('GL_SGIS_texture_lod'); Result := True; end; function ImageFormatToGL(Format: TImageFormat; var GLFormat: GLenum; var GLType: GLenum; var GLInternal: GLint; const Caps: TGLTextureCaps): Boolean; begin GLFormat := 0; GLType := 0; GLInternal := 0; case Format of // Gray formats ifGray8, ifGray16: begin GLFormat := GL_LUMINANCE; GLType := Iff(Format = ifGray8, GL_UNSIGNED_BYTE, GL_UNSIGNED_SHORT); GLInternal := Iff(Format = ifGray8, GL_LUMINANCE8, GL_LUMINANCE16); end; ifA8Gray8, ifA16Gray16: begin GLFormat := GL_LUMINANCE_ALPHA; GLType := Iff(Format = ifA8Gray8, GL_UNSIGNED_BYTE, GL_UNSIGNED_SHORT); GLInternal := Iff(Format = ifA8Gray8, GL_LUMINANCE8_ALPHA8, GL_LUMINANCE16_ALPHA16); end; // RGBA formats ifR3G3B2: begin GLFormat := GL_RGB; GLType := GL_UNSIGNED_BYTE_3_3_2; GLInternal := GL_R3_G3_B2; end; ifR5G6B5: begin GLFormat := GL_RGB; GLType := GL_UNSIGNED_SHORT_5_6_5; GLInternal := GL_RGB5; end; ifA1R5G5B5, ifX1R5G5B5: begin GLFormat := GL_BGRA_EXT; GLType := GL_UNSIGNED_SHORT_1_5_5_5_REV; GLInternal := Iff(Format = ifA1R5G5B5, GL_RGB5_A1, GL_RGB5); end; ifA4R4G4B4, ifX4R4G4B4: begin GLFormat := GL_BGRA_EXT; GLType := GL_UNSIGNED_SHORT_4_4_4_4_REV; GLInternal := Iff(Format = ifA4R4G4B4, GL_RGBA4, GL_RGB4); end; ifR8G8B8: begin GLFormat := GL_BGR_EXT; GLType := GL_UNSIGNED_BYTE; GLInternal := GL_RGB8; end; ifA8R8G8B8, ifX8R8G8B8: begin GLFormat := GL_BGRA_EXT; GLType := GL_UNSIGNED_BYTE; GLInternal := Iff(Format = ifA8R8G8B8, GL_RGBA8, GL_RGB8); end; ifR16G16B16, ifB16G16R16: begin GLFormat := Iff(Format = ifR16G16B16, GL_BGR_EXT, GL_RGB); GLType := GL_UNSIGNED_SHORT; GLInternal := GL_RGB16; end; ifA16R16G16B16, ifA16B16G16R16: begin GLFormat := Iff(Format = ifA16R16G16B16, GL_BGRA_EXT, GL_RGBA); GLType := GL_UNSIGNED_SHORT; GLInternal := GL_RGBA16; end; // Floating-Point formats ifR32F: begin GLFormat := GL_RED; GLType := GL_FLOAT; GLInternal := GL_LUMINANCE32F_ARB; end; ifA32R32G32B32F, ifA32B32G32R32F: begin GLFormat := Iff(Format = ifA32R32G32B32F, GL_BGRA_EXT, GL_RGBA); GLType := GL_FLOAT; GLInternal := GL_RGBA32F_ARB; end; ifR16F: begin GLFormat := GL_RED; GLType := GL_HALF_FLOAT_ARB; GLInternal := GL_LUMINANCE16F_ARB; end; ifA16R16G16B16F, ifA16B16G16R16F: begin GLFormat := Iff(Format = ifA16R16G16B16F, GL_BGRA_EXT, GL_RGBA); GLType := GL_HALF_FLOAT_ARB; GLInternal := GL_RGBA16F_ARB; end; // Special formats ifDXT1: GLInternal := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT; ifDXT3: GLInternal := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT; ifDXT5: GLInternal := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT; ifATI1N: GLInternal := GL_COMPRESSED_LUMINANCE_LATC1_EXT; ifATI2N: begin GLInternal := GL_COMPRESSED_LUMINANCE_ALPHA_LATC2_EXT; if not Caps.LATCCompression and Caps.ATI3DcCompression then GLInternal := GL_COMPRESSED_LUMINANCE_ALPHA_3DC_ATI; end; end; Result := GLInternal <> 0; end; function LoadGLTextureFromFile(const FileName: string; CreatedWidth, CreatedHeight: PLongInt): GLuint; var Images: TDynImageDataArray; begin if LoadMultiImageFromFile(FileName, Images) and (Length(Images) > 0) then begin Result := CreateGLTextureFromMultiImage(Images, Images[0].Width, Images[0].Height, True, 0, ifUnknown, CreatedWidth, CreatedHeight); end else Result := 0; FreeImagesInArray(Images); end; function LoadGLTextureFromStream(Stream: TStream; CreatedWidth, CreatedHeight: PLongInt): GLuint; var Images: TDynImageDataArray; begin if LoadMultiImageFromStream(Stream, Images) and (Length(Images) > 0) then begin Result := CreateGLTextureFromMultiImage(Images, Images[0].Width, Images[0].Height, True, 0, ifUnknown, CreatedWidth, CreatedHeight); end else Result := 0; FreeImagesInArray(Images); end; function LoadGLTextureFromMemory(Data: Pointer; Size: LongInt; CreatedWidth, CreatedHeight: PLongInt): GLuint; var Images: TDynImageDataArray; begin if LoadMultiImageFromMemory(Data, Size, Images) and (Length(Images) > 0) then begin Result := CreateGLTextureFromMultiImage(Images, Images[0].Width, Images[0].Height, True, 0, ifUnknown, CreatedWidth, CreatedHeight); end else Result := 0; FreeImagesInArray(Images); end; function CreateGLTextureFromImage(const Image: TImageData; Width, Height: LongInt; MipMaps: Boolean; OverrideFormat: TImageFormat; CreatedWidth, CreatedHeight: PLongInt): GLuint; var Arr: TDynImageDataArray; begin // Just calls function operating on image arrays SetLength(Arr, 1); Arr[0] := Image; Result := CreateGLTextureFromMultiImage(Arr, Width, Height, MipMaps, 0, OverrideFormat, CreatedWidth, CreatedHeight); end; function CreateGLTextureFromMultiImage(const Images: TDynImageDataArray; Width, Height: LongInt; MipMaps: Boolean; MainLevelIndex: LongInt; OverrideFormat: TImageFormat; CreatedWidth, CreatedHeight: PLongInt): GLuint; const BlockCompressedFormats: TImageFormats = [ifDXT1, ifDXT3, ifDXT5, ifATI1N, ifATI2N]; var I, MipLevels, PossibleLevels, ExistingLevels, CurrentWidth, CurrentHeight: LongInt; Caps: TGLTextureCaps; GLFormat: GLenum; GLType: GLenum; GLInternal: GLint; Desired, ConvTo: TImageFormat; Info: TImageFormatInfo; LevelsArray: TDynImageDataArray; NeedsResize, NeedsConvert: Boolean; UnpackAlignment, UnpackSkipRows, UnpackSkipPixels, UnpackRowLength: LongInt; procedure PasteImage(var Image: TImageData; Width, Height: LongInt); var Clone: TImageData; begin CloneImage(Image, Clone); NewImage(Width, Height, Clone.Format, Image); FillRect(Image, 0, 0, Width, Height, Clone.Bits); CopyRect(Clone, 0, 0, Clone.Width, Clone.Height, Image, 0, 0); FreeImage(Clone); end; begin Result := 0; ExistingLevels := Length(Images); if GetGLTextureCaps(Caps) and (ExistingLevels > 0) then try // Check if requested main level is at valid index if (MainLevelIndex < 0) or (MainLevelIndex > High(Images)) then MainLevelIndex := 0; // First check desired size and modify it if necessary if Width <= 0 then Width := Images[MainLevelIndex].Width; if Height <= 0 then Height := Images[MainLevelIndex].Height; if not Caps.NonPowerOfTwo and not DisableNPOTSupportCheck then begin // If device supports only power of 2 texture sizes Width := NextPow2(Width); Height := NextPow2(Height); end; Width := ClampInt(Width, 1, Caps.MaxTextureSize); Height := ClampInt(Height, 1, Caps.MaxTextureSize); // Get various mipmap level counts and modify // desired MipLevels if its value is invalid PossibleLevels := GetNumMipMapLevels(Width, Height); if MipMaps then MipLevels := PossibleLevels else MipLevels := 1; // Prepare array for mipmap levels. Make it larger than necessary - that // way we can use the same index for input images and levels in the large loop below SetLength(LevelsArray, MipLevels + MainLevelIndex); // Now determine which image format will be used if OverrideFormat = ifUnknown then Desired := Images[MainLevelIndex].Format else Desired := OverrideFormat; // Check if the hardware supports floating point and compressed textures GetImageFormatInfo(Desired, Info); if Info.IsFloatingPoint and not Caps.FloatTextures then Desired := ifA8R8G8B8; if (Desired in [ifDXT1, ifDXT3, ifDXT5]) and not Caps.DXTCompression then Desired := ifA8R8G8B8; if (Desired = ifATI1N) and not Caps.LATCCompression then Desired := ifGray8; if (Desired = ifATI2N) and not (Caps.ATI3DcCompression or Caps.LATCCompression) then Desired := ifA8Gray8; // Try to find GL format equivalent to image format and if it is not // found use one of default formats if not ImageFormatToGL(Desired, GLFormat, GLType, GLInternal, Caps) then begin GetImageFormatInfo(Desired, Info); if Info.HasGrayChannel then ConvTo := ifGray8 else ConvTo := ifA8R8G8B8; if not ImageFormatToGL(ConvTo, GLFormat, GLType, GLInternal, Caps) then Exit; end else ConvTo := Desired; CurrentWidth := Width; CurrentHeight := Height; // If user is interested in width and height of created texture lets // give him that if CreatedWidth <> nil then CreatedWidth^ := CurrentWidth; if CreatedHeight <> nil then CreatedHeight^ := CurrentHeight; // Store old pixel unpacking settings glGetIntegerv(GL_UNPACK_ALIGNMENT, @UnpackAlignment); glGetIntegerv(GL_UNPACK_SKIP_ROWS, @UnpackSkipRows); glGetIntegerv(GL_UNPACK_SKIP_PIXELS, @UnpackSkipPixels); glGetIntegerv(GL_UNPACK_ROW_LENGTH, @UnpackRowLength); // Set new pixel unpacking settings glPixelStorei(GL_UNPACK_ALIGNMENT, 1); glPixelStorei(GL_UNPACK_SKIP_ROWS, 0); glPixelStorei(GL_UNPACK_SKIP_PIXELS, 0); glPixelStorei(GL_UNPACK_ROW_LENGTH, 0); // Generate new texture, bind it and set glGenTextures(1, @Result); glBindTexture(GL_TEXTURE_2D, Result); if Byte(glIsTexture(Result)) <> GL_TRUE then Exit; for I := MainLevelIndex to MipLevels - 1 + MainLevelIndex do begin // Check if we can use input image array as a source for this mipmap level if I < ExistingLevels then begin // Check if input image for this mipmap level has the right // size and format NeedsConvert := not (Images[I].Format = ConvTo); if ConvTo in BlockCompressedFormats then begin // Input images in DXTC will have min dimensions of 4, but we need // current Width and Height to be lesser (for glCompressedTexImage2D) NeedsResize := not ((Images[I].Width = Max(4, CurrentWidth)) and (Images[I].Height = Max(4, CurrentHeight))); end else NeedsResize := not ((Images[I].Width = CurrentWidth) and (Images[I].Height = CurrentHeight)); if NeedsResize or NeedsConvert then begin // Input image must be resized or converted to different format // to become valid mipmap level CloneImage(Images[I], LevelsArray[I]); if NeedsConvert then ConvertImage(LevelsArray[I], ConvTo); if NeedsResize then begin if (not PasteNonPow2ImagesIntoPow2) or (LevelsArray[I].Width > CurrentWidth) or (LevelsArray[I].Height > CurrentHeight)then begin // If pasteNP2toP2 is disabled or if source is bigger than target // we rescale image, otherwise we paste it with the same size ResizeImage(LevelsArray[I], CurrentWidth, CurrentHeight, rfBilinear) end else PasteImage(LevelsArray[I], CurrentWidth, CurrentHeight); end; end else // Input image can be used without any changes LevelsArray[I] := Images[I]; end else begin // This mipmap level is not present in the input image array // so we create a new level FillMipMapLevel(LevelsArray[I - 1], CurrentWidth, CurrentHeight, LevelsArray[I]); end; if ConvTo in BlockCompressedFormats then begin // Note: GL DXTC texture snaller than 4x4 must have width and height // as expected for non-DXTC texture (like 1x1 - we cannot // use LevelsArray[I].Width and LevelsArray[I].Height - they are // at least 4 for DXTC images). But Bits and Size passed to // glCompressedTexImage2D must contain regular 4x4 DXTC block. glCompressedTexImage2D(GL_TEXTURE_2D, I - MainLevelIndex, GLInternal, CurrentWidth, CurrentHeight, 0, LevelsArray[I].Size, LevelsArray[I].Bits) end else begin glTexImage2D(GL_TEXTURE_2D, I - MainLevelIndex, GLInternal, CurrentWidth, CurrentHeight, 0, GLFormat, GLType, LevelsArray[I].Bits); end; // Calculate width and height of the next mipmap level CurrentWidth := ClampInt(CurrentWidth div 2, 1, CurrentWidth); CurrentHeight := ClampInt(CurrentHeight div 2, 1, CurrentHeight); end; // Restore old pixel unpacking settings glPixelStorei(GL_UNPACK_ALIGNMENT, UnpackAlignment); glPixelStorei(GL_UNPACK_SKIP_ROWS, UnpackSkipRows); glPixelStorei(GL_UNPACK_SKIP_PIXELS, UnpackSkipPixels); glPixelStorei(GL_UNPACK_ROW_LENGTH, UnpackRowLength); finally // Free local image copies for I := 0 to Length(LevelsArray) - 1 do begin if ((I < ExistingLevels) and (LevelsArray[I].Bits <> Images[I].Bits)) or (I >= ExistingLevels) then FreeImage(LevelsArray[I]); end; end; end; function SaveGLTextureToFile(const FileName: string; const Texture: GLuint): Boolean; var Arr: TDynImageDataArray; Fmt: TImageFileFormat; IsDDS: Boolean; begin Result := CreateMultiImageFromGLTexture(Texture, Arr); if Result then begin Fmt := FindImageFileFormatByName(FileName); if Fmt <> nil then begin IsDDS := SameText(Fmt.Extensions[0], 'dds'); if IsDDS then begin PushOptions; SetOption(ImagingDDSSaveMipMapCount, Length(Arr)); end; Result := SaveMultiImageToFile(FileName, Arr); if IsDDS then PopOptions; end; FreeImagesInArray(Arr); end; end; function SaveGLTextureToStream(const Ext: string; Stream: TStream; const Texture: GLuint): Boolean; var Arr: TDynImageDataArray; Fmt: TImageFileFormat; IsDDS: Boolean; begin Result := CreateMultiImageFromGLTexture(Texture, Arr); if Result then begin Fmt := FindImageFileFormatByExt(Ext); if Fmt <> nil then begin IsDDS := SameText(Fmt.Extensions[0], 'dds'); if IsDDS then begin PushOptions; SetOption(ImagingDDSSaveMipMapCount, Length(Arr)); end; Result := SaveMultiImageToStream(Ext, Stream, Arr); if IsDDS then PopOptions; end; FreeImagesInArray(Arr); end; end; function SaveGLTextureToMemory(const Ext: string; Data: Pointer; var Size: LongInt; const Texture: GLuint): Boolean; var Arr: TDynImageDataArray; Fmt: TImageFileFormat; IsDDS: Boolean; begin Result := CreateMultiImageFromGLTexture(Texture, Arr); if Result then begin Fmt := FindImageFileFormatByExt(Ext); if Fmt <> nil then begin IsDDS := SameText(Fmt.Extensions[0], 'dds'); if IsDDS then begin PushOptions; SetOption(ImagingDDSSaveMipMapCount, Length(Arr)); end; Result := SaveMultiImageToMemory(Ext, Data, Size, Arr); if IsDDS then PopOptions; end; FreeImagesInArray(Arr); end; end; function CreateImageFromGLTexture(const Texture: GLuint; var Image: TImageData; OverrideFormat: TImageFormat): Boolean; var Arr: TDynImageDataArray; begin // Just calls function operating on image arrays FreeImage(Image); SetLength(Arr, 1); Result := CreateMultiImageFromGLTexture(Texture, Arr, 1, OverrideFormat); Image := Arr[0]; end; function CreateMultiImageFromGLTexture(const Texture: GLuint; var Images: TDynImageDataArray; MipLevels: LongInt; OverrideFormat: TImageFormat): Boolean; var I, Width, Height, ExistingLevels: LongInt; begin FreeImagesInArray(Images); SetLength(Images, 0); Result := False; if Byte(glIsTexture(Texture)) = GL_TRUE then begin // Check if desired mipmap level count is valid glBindTexture(GL_TEXTURE_2D, Texture); if MipLevels <= 0 then MipLevels := GetNumMipMapLevels(Width, Height); SetLength(Images, MipLevels); ExistingLevels := 0; for I := 0 to MipLevels - 1 do begin // Get the current level size glGetTexLevelParameteriv(GL_TEXTURE_2D, I, GL_TEXTURE_WIDTH, @Width); glGetTexLevelParameteriv(GL_TEXTURE_2D, I, GL_TEXTURE_HEIGHT, @Height); // Break when the mipmap chain is broken if (Width = 0) or (Height = 0) then Break; // Create new image and copy texture data NewImage(Width, Height, ifA8R8G8B8, Images[I]); glGetTexImage(GL_TEXTURE_2D, I, GL_BGRA_EXT, GL_UNSIGNED_BYTE, Images[I].Bits); Inc(ExistingLevels); end; // Resize mipmap array if necessary if MipLevels <> ExistingLevels then SetLength(Images, ExistingLevels); // Convert images to desired format if set if OverrideFormat <> ifUnknown then for I := 0 to Length(Images) - 1 do ConvertImage(Images[I], OverrideFormat); Result := True; end; end; initialization { File Notes: -- TODOS ---------------------------------------------------- - use internal format of texture in CreateMultiImageFromGLTexture not only A8R8G8B8 - support for cube and 3D maps -- 0.26.1 Changes/Bug Fixes --------------------------------- - Added support for GLScene's OpenGL header. -- 0.25.0 Changes/Bug Fixes --------------------------------- - Added 3Dc compressed texture formats support. - Added detection of 3Dc formats to texture caps. -- 0.24.3 Changes/Bug Fixes --------------------------------- - Added DisableNPOTSupportCheck option and related functionality. - Added some new texture caps detection. -- 0.24.1 Changes/Bug Fixes --------------------------------- - Added PasteNonPow2ImagesIntoPow2 option and related functionality. - Better NeedsResize determination for small DXTC textures - avoids needless resizing. - Added MainLevelIndex to CreateMultiImageFromGLTexture. -- 0.21 Changes/Bug Fixes ----------------------------------- - Added CreatedWidth and CreatedHeight parameters to most LoadGLTextureFromXXX/CreateGLTextureFromXXX functions. -- 0.19 Changes/Bug Fixes ----------------------------------- - fixed bug in CreateGLTextureFromMultiImage which caused assert failure when creating mipmaps (using FillMipMapLevel) for DXTC formats - changed single channel floating point texture formats from GL_INTENSITY..._ARB to GL_LUMINANCE..._ARB - added support for half float texture formats (GL_RGBA16F_ARB etc.) -- 0.17 Changes/Bug Fixes ----------------------------------- - filtered mipmap creation - more texture caps added - fixed memory leaks in SaveGLTextureTo... functions -- 0.15 Changes/Bug Fixes ----------------------------------- - unit created and initial stuff added } end.