{ glBitmap by Steffen Xonna aka Lossy eX (2003-2008) http://www.opengl24.de/index.php?cat=header&file=glbitmap modified by Delphi OpenGL Community (http://delphigl.com/) (2013) 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 The glBitmap is a Delphi/FPC unit that contains several wrapper classes to manage OpenGL texture objects. Below you can find a list of the main functionality of this classes: - load texture data from file (e.g. BMP, TGA, DDS, PNG, JPEG, ...) - load texture data from several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface) - save texture data to file (e.g. BMP, TGA, DDS, PNG, JPEG, ...) - save texture data to several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface) - support for many texture formats (e.g. RGB8, BGR8, RGBA8, BGRA8, ...) - manage texture properties (e.g. Filter, Clamp, Mipmap, ...) - upload texture data to video card - download texture data from video card - manipulate texture data (e.g. add alpha, remove alpha, convert to other format, switch RGB, ...) } unit glBitmap; // Please uncomment the defines below to configure the glBitmap to your preferences. // If you have configured the unit you can uncomment the warning above. {.$MESSAGE error 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // Preferences /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // enable support for OpenGL ES 1.1 {.$DEFINE OPENGL_ES_1_1} // enable support for OpenGL ES 2.0 {.$DEFINE OPENGL_ES_2_0} // enable support for OpenGL ES 3.0 {.$DEFINE OPENGL_ES_3_0} // enable support for all OpenGL ES extensions {.$DEFINE OPENGL_ES_EXT} // activate to enable the support for SDL_surfaces {.$DEFINE GLB_SDL} // activate to enable the support for Delphi (including support for Delphi's (not Lazarus') TBitmap) {.$DEFINE GLB_DELPHI} // activate to enable the support for TLazIntfImage from Lazarus {.$DEFINE GLB_LAZARUS} // activate to enable the support of SDL_image to load files. (READ ONLY) // If you enable SDL_image all other libraries will be ignored! {.$DEFINE GLB_SDL_IMAGE} // activate to enable Lazarus TPortableNetworkGraphic support // if you enable this pngImage and libPNG will be ignored {.$DEFINE GLB_LAZ_PNG} // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/ // if you enable pngimage the libPNG will be ignored {.$DEFINE GLB_PNGIMAGE} // activate to use the libPNG -> http://www.libpng.org/ // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng {.$DEFINE GLB_LIB_PNG} // activate to enable Lazarus TJPEGImage support // if you enable this delphi jpegs and libJPEG will be ignored {.$DEFINE GLB_LAZ_JPEG} // if you enable delphi jpegs the libJPEG will be ignored {.$DEFINE GLB_DELPHI_JPEG} // activate to use the libJPEG -> http://www.ijg.org/ // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg {.$DEFINE GLB_LIB_JPEG} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // PRIVATE: do not change anything! ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // Delphi Versions {$IFDEF fpc} {$MODE Delphi} {$IFDEF CPUI386} {$DEFINE CPU386} {$ASMMODE INTEL} {$ENDIF} {$IFNDEF WINDOWS} {$linklib c} {$ENDIF} {$ENDIF} // Operation System {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)} {$DEFINE GLB_WIN} {$ELSEIF DEFINED(LINUX)} {$DEFINE GLB_LINUX} {$IFEND} // OpenGL ES {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND} {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND} {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND} {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES} {$IFEND} // checking define combinations //SDL Image {$IFDEF GLB_SDL_IMAGE} {$IFNDEF GLB_SDL} {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'} {$DEFINE GLB_SDL} {$ENDIF} {$IFDEF GLB_LAZ_PNG} {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'} {$undef GLB_LAZ_PNG} {$ENDIF} {$IFDEF GLB_PNGIMAGE} {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'} {$undef GLB_PNGIMAGE} {$ENDIF} {$IFDEF GLB_LAZ_JPEG} {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'} {$undef GLB_LAZ_JPEG} {$ENDIF} {$IFDEF GLB_DELPHI_JPEG} {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'} {$undef GLB_DELPHI_JPEG} {$ENDIF} {$IFDEF GLB_LIB_PNG} {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'} {$undef GLB_LIB_PNG} {$ENDIF} {$IFDEF GLB_LIB_JPEG} {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'} {$undef GLB_LIB_JPEG} {$ENDIF} {$DEFINE GLB_SUPPORT_PNG_READ} {$DEFINE GLB_SUPPORT_JPEG_READ} {$ENDIF} // Lazarus TPortableNetworkGraphic {$IFDEF GLB_LAZ_PNG} {$IFNDEF GLB_LAZARUS} {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'} {$DEFINE GLB_LAZARUS} {$ENDIF} {$IFDEF GLB_PNGIMAGE} {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'} {$undef GLB_PNGIMAGE} {$ENDIF} {$IFDEF GLB_LIB_PNG} {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'} {$undef GLB_LIB_PNG} {$ENDIF} {$DEFINE GLB_SUPPORT_PNG_READ} {$DEFINE GLB_SUPPORT_PNG_WRITE} {$ENDIF} // PNG Image {$IFDEF GLB_PNGIMAGE} {$IFDEF GLB_LIB_PNG} {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'} {$undef GLB_LIB_PNG} {$ENDIF} {$DEFINE GLB_SUPPORT_PNG_READ} {$DEFINE GLB_SUPPORT_PNG_WRITE} {$ENDIF} // libPNG {$IFDEF GLB_LIB_PNG} {$DEFINE GLB_SUPPORT_PNG_READ} {$DEFINE GLB_SUPPORT_PNG_WRITE} {$ENDIF} // Lazarus TJPEGImage {$IFDEF GLB_LAZ_JPEG} {$IFNDEF GLB_LAZARUS} {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'} {$DEFINE GLB_LAZARUS} {$ENDIF} {$IFDEF GLB_DELPHI_JPEG} {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'} {$undef GLB_DELPHI_JPEG} {$ENDIF} {$IFDEF GLB_LIB_JPEG} {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'} {$undef GLB_LIB_JPEG} {$ENDIF} {$DEFINE GLB_SUPPORT_JPEG_READ} {$DEFINE GLB_SUPPORT_JPEG_WRITE} {$ENDIF} // JPEG Image {$IFDEF GLB_DELPHI_JPEG} {$IFDEF GLB_LIB_JPEG} {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'} {$undef GLB_LIB_JPEG} {$ENDIF} {$DEFINE GLB_SUPPORT_JPEG_READ} {$DEFINE GLB_SUPPORT_JPEG_WRITE} {$ENDIF} // libJPEG {$IFDEF GLB_LIB_JPEG} {$DEFINE GLB_SUPPORT_JPEG_READ} {$DEFINE GLB_SUPPORT_JPEG_WRITE} {$ENDIF} // general options {$EXTENDEDSYNTAX ON} {$LONGSTRINGS ON} {$ALIGN ON} {$IFNDEF FPC} {$OPTIMIZATION ON} {$ENDIF} interface uses {$IFDEF OPENGL_ES} dglOpenGLES, {$ELSE} dglOpenGL, {$ENDIF} {$IF DEFINED(GLB_WIN) AND DEFINED(GLB_DELPHI)} windows, {$IFEND} {$IFDEF GLB_SDL} SDL, {$ENDIF} {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF} {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$ENDIF} {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF} {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF} {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF} {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF} {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF} Classes, SysUtils; type {$IFNDEF fpc} QWord = System.UInt64; PQWord = ^QWord; PtrInt = Longint; PtrUInt = DWord; {$ENDIF} { type that describes the format of the data stored in a texture. the name of formats is composed of the following constituents: - multiple channels: - channel (e.g. R, G, B, A or Alpha, Luminance or X (reserved)) - width of the chanel in bit (4, 8, 16, ...) - data type (e.g. ub, us, ui) - number of elements of data types } TglBitmapFormat = ( tfEmpty = 0, tfAlpha4ub1, //< 1 x unsigned byte tfAlpha8ub1, //< 1 x unsigned byte tfAlpha16us1, //< 1 x unsigned short tfLuminance4ub1, //< 1 x unsigned byte tfLuminance8ub1, //< 1 x unsigned byte tfLuminance16us1, //< 1 x unsigned short tfLuminance4Alpha4ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha) tfLuminance6Alpha2ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha) tfLuminance8Alpha8ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha) tfLuminance12Alpha4us2, //< 1 x unsigned short (lum), 1 x unsigned short (alpha) tfLuminance16Alpha16us2, //< 1 x unsigned short (lum), 1 x unsigned short (alpha) tfR3G3B2ub1, //< 1 x unsigned byte (3bit red, 3bit green, 2bit blue) tfRGBX4us1, //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd) tfXRGB4us1, //< 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue) tfR5G6B5us1, //< 1 x unsigned short (5bit red, 6bit green, 5bit blue) tfRGB5X1us1, //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved) tfX1RGB5us1, //< 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue) tfRGB8ub3, //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue) tfRGBX8ui1, //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved) tfXRGB8ui1, //< 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue) tfRGB10X2ui1, //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved) tfX2RGB10ui1, //< 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue) tfRGB16us3, //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue) tfRGBA4us1, //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha) tfARGB4us1, //< 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue) tfRGB5A1us1, //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha) tfA1RGB5us1, //< 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue) tfRGBA8ui1, //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha) tfARGB8ui1, //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue) tfRGBA8ub4, //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha) tfRGB10A2ui1, //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha) tfA2RGB10ui1, //< 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue) tfRGBA16us4, //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha) tfBGRX4us1, //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved) tfXBGR4us1, //< 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red) tfB5G6R5us1, //< 1 x unsigned short (5bit blue, 6bit green, 5bit red) tfBGR5X1us1, //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved) tfX1BGR5us1, //< 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red) tfBGR8ub3, //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red) tfBGRX8ui1, //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved) tfXBGR8ui1, //< 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red) tfBGR10X2ui1, //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved) tfX2BGR10ui1, //< 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red) tfBGR16us3, //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red) tfBGRA4us1, //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha) tfABGR4us1, //< 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red) tfBGR5A1us1, //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha) tfA1BGR5us1, //< 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red) tfBGRA8ui1, //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha) tfABGR8ui1, //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red) tfBGRA8ub4, //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha) tfBGR10A2ui1, //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha) tfA2BGR10ui1, //< 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red) tfBGRA16us4, //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha) tfDepth16us1, //< 1 x unsigned short (depth) tfDepth24ui1, //< 1 x unsigned int (depth) tfDepth32ui1, //< 1 x unsigned int (depth) tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA ); { type to define suitable file formats } TglBitmapFileType = ( {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF} //< Portable Network Graphic file (PNG) {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF} //< JPEG file ftDDS, //< Direct Draw Surface file (DDS) ftTGA, //< Targa Image File (TGA) ftBMP, //< Windows Bitmap File (BMP) ftRAW); //< glBitmap RAW file format TglBitmapFileTypes = set of TglBitmapFileType; { possible mipmap types } TglBitmapMipMap = ( mmNone, //< no mipmaps mmMipmap, //< normal mipmaps mmMipmapGlu); //< mipmaps generated with glu functions { possible normal map functions } TglBitmapNormalMapFunc = ( nm4Samples, nmSobel, nm3x3, nm5x5); //////////////////////////////////////////////////////////////////////////////////////////////////// EglBitmap = class(Exception); //< glBitmap exception EglBitmapNotSupported = class(Exception); //< exception for not supported functions EglBitmapSizeToLarge = class(EglBitmap); //< exception for to large textures EglBitmapNonPowerOfTwo = class(EglBitmap); //< exception for non power of two textures EglBitmapUnsupportedFormat = class(EglBitmap) //< exception for unsupporetd formats public constructor Create(const aFormat: TglBitmapFormat); overload; constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload; end; //////////////////////////////////////////////////////////////////////////////////////////////////// { record that stores 4 unsigned integer values } TglBitmapRec4ui = packed record case Integer of 0: (r, g, b, a: Cardinal); 1: (arr: array[0..3] of Cardinal); end; { record that stores 4 unsigned byte values } TglBitmapRec4ub = packed record case Integer of 0: (r, g, b, a: Byte); 1: (arr: array[0..3] of Byte); end; { record that stores 4 unsigned long integer values } TglBitmapRec4ul = packed record case Integer of 0: (r, g, b, a: QWord); 1: (arr: array[0..3] of QWord); end; { describes the properties of a given texture data format } TglBitmapFormatDescriptor = class(TObject) private // cached properties fBytesPerPixel: Single; //< number of bytes for each pixel fChannelCount: Integer; //< number of color channels fMask: TglBitmapRec4ul; //< bitmask for each color channel fRange: TglBitmapRec4ui; //< maximal value of each color channel { @return @true if the format has a red color channel, @false otherwise } function GetHasRed: Boolean; { @return @true if the format has a green color channel, @false otherwise } function GetHasGreen: Boolean; { @return @true if the format has a blue color channel, @false otherwise } function GetHasBlue: Boolean; { @return @true if the format has a alpha color channel, @false otherwise } function GetHasAlpha: Boolean; { @return @true if the format has any color color channel, @false otherwise } function GetHasColor: Boolean; { @return @true if the format is a grayscale format, @false otherwise } function GetIsGrayscale: Boolean; protected fFormat: TglBitmapFormat; //< format this descriptor belongs to fWithAlpha: TglBitmapFormat; //< suitable format with alpha channel fWithoutAlpha: TglBitmapFormat; //< suitable format without alpha channel fOpenGLFormat: TglBitmapFormat; //< suitable format that is supported by OpenGL fRGBInverted: TglBitmapFormat; //< suitable format with inverted RGB channels fUncompressed: TglBitmapFormat; //< suitable format with uncompressed data fBitsPerPixel: Integer; //< number of bits per pixel fIsCompressed: Boolean; //< @true if the format is compressed, @false otherwise fPrecision: TglBitmapRec4ub; //< number of bits for each color channel fShift: TglBitmapRec4ub; //< bit offset for each color channel fglFormat: GLenum; //< OpenGL format enum (e.g. GL_RGB) fglInternalFormat: GLenum; //< OpenGL internal format enum (e.g. GL_RGB8) fglDataFormat: GLenum; //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE) { set values for this format descriptor } procedure SetValues; virtual; { calculate cached values } procedure CalcValues; public property Format: TglBitmapFormat read fFormat; //< format this descriptor belongs to property ChannelCount: Integer read fChannelCount; //< number of color channels property IsCompressed: Boolean read fIsCompressed; //< @true if the format is compressed, @false otherwise property BitsPerPixel: Integer read fBitsPerPixel; //< number of bytes per pixel property BytesPerPixel: Single read fBytesPerPixel; //< number of bits per pixel property Precision: TglBitmapRec4ub read fPrecision; //< number of bits for each color channel property Shift: TglBitmapRec4ub read fShift; //< bit offset for each color channel property Range: TglBitmapRec4ui read fRange; //< maximal value of each color channel property Mask: TglBitmapRec4ul read fMask; //< bitmask for each color channel property RGBInverted: TglBitmapFormat read fRGBInverted; //< suitable format with inverted RGB channels property WithAlpha: TglBitmapFormat read fWithAlpha; //< suitable format with alpha channel property WithoutAlpha: TglBitmapFormat read fWithAlpha; //< suitable format without alpha channel property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data property glFormat: GLenum read fglFormat; //< OpenGL format enum (e.g. GL_RGB) property glInternalFormat: GLenum read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8) property glDataFormat: GLenum read fglDataFormat; //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE) property HasRed: Boolean read GetHasRed; //< @true if the format has a red color channel, @false otherwise property HasGreen: Boolean read GetHasGreen; //< @true if the format has a green color channel, @false otherwise property HasBlue: Boolean read GetHasBlue; //< @true if the format has a blue color channel, @false otherwise property HasAlpha: Boolean read GetHasAlpha; //< @true if the format has a alpha color channel, @false otherwise property HasColor: Boolean read GetHasColor; //< @true if the format has any color color channel, @false otherwise property IsGrayscale: Boolean read GetIsGrayscale; //< @true if the format is a grayscale format, @false otherwise { constructor } constructor Create; public { get the format descriptor by a given OpenGL internal format @param aInternalFormat OpenGL internal format to get format descriptor for @returns suitable format descriptor or tfEmpty-Descriptor } class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor; end; //////////////////////////////////////////////////////////////////////////////////////////////////// { structure to store pixel data in } TglBitmapPixelData = packed record Data: TglBitmapRec4ui; //< color data for each color channel Range: TglBitmapRec4ui; //< maximal color value for each channel Format: TglBitmapFormat; //< format of the pixel end; PglBitmapPixelData = ^TglBitmapPixelData; TglBitmapSizeFields = set of (ffX, ffY); TglBitmapSize = packed record Fields: TglBitmapSizeFields; X: Word; Y: Word; end; TglBitmapPixelPosition = TglBitmapSize; //////////////////////////////////////////////////////////////////////////////////////////////////// TglBitmap = class; { structure to store data for converting in } TglBitmapFunctionRec = record Sender: TglBitmap; //< texture object that stores the data to convert Size: TglBitmapSize; //< size of the texture Position: TglBitmapPixelPosition; //< position of the currently pixel Source: TglBitmapPixelData; //< pixel data of the current pixel Dest: TglBitmapPixelData; //< new data of the pixel (must be filled in) Args: Pointer; //< user defined args that was passed to the convert function end; { callback to use for converting texture data } TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec); ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// { base class for all glBitmap classes. used to manage OpenGL texture objects and to load, save and manipulate texture data } TglBitmap = class private { @returns format descriptor that describes the format of the stored data } function GetFormatDesc: TglBitmapFormatDescriptor; protected fID: GLuint; //< name of the OpenGL texture object fTarget: GLuint; //< texture target (e.g. GL_TEXTURE_2D) fAnisotropic: Integer; //< anisotropic level fDeleteTextureOnFree: Boolean; //< delete OpenGL texture object when this object is destroyed fFreeDataOnDestroy: Boolean; //< free stored data when this object is destroyed fFreeDataAfterGenTexture: Boolean; //< free stored data after data was uploaded to video card fData: PByte; //< data of this texture {$IFNDEF OPENGL_ES} fIsResident: GLboolean; //< @true if OpenGL texture object has data, @false otherwise {$ENDIF} fBorderColor: array[0..3] of Single; //< color of the texture border fDimension: TglBitmapSize; //< size of this texture fMipMap: TglBitmapMipMap; //< mipmap type fFormat: TglBitmapFormat; //< format the texture data is stored in // Mapping fPixelSize: Integer; //< size of one pixel (in byte) fRowSize: Integer; //< size of one pixel row (in byte) // Filtering fFilterMin: GLenum; //< min filter to apply to the texture fFilterMag: GLenum; //< mag filter to apply to the texture // TexturWarp fWrapS: GLenum; //< texture wrapping for x axis fWrapT: GLenum; //< texture wrapping for y axis fWrapR: GLenum; //< texture wrapping for z axis {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} //Swizzle fSwizzle: array[0..3] of GLenum; //< color channel swizzle {$IFEND} // CustomData fFilename: String; //< filename the texture was load from fCustomName: String; //< user defined name fCustomNameW: WideString; //< user defined name fCustomData: Pointer; //< user defined data protected { @returns the actual width of the texture } function GetWidth: Integer; virtual; { @returns the actual height of the texture } function GetHeight: Integer; virtual; { @returns the width of the texture or 1 if the width is zero } function GetFileWidth: Integer; virtual; { @returns the height of the texture or 1 if the height is zero } function GetFileHeight: Integer; virtual; protected { set a new value for fCustomData } procedure SetCustomData(const aValue: Pointer); { set a new value for fCustomName } procedure SetCustomName(const aValue: String); { set a new value for fCustomNameW } procedure SetCustomNameW(const aValue: WideString); { set new value for fFreeDataOnDestroy } procedure SetFreeDataOnDestroy(const aValue: Boolean); { set new value for fDeleteTextureOnFree } procedure SetDeleteTextureOnFree(const aValue: Boolean); { set new value for the data format. only possible if new format has the same pixel size. if you want to convert the texture data, see ConvertTo function } procedure SetFormat(const aValue: TglBitmapFormat); { set new value for fFreeDataAfterGenTexture } procedure SetFreeDataAfterGenTexture(const aValue: Boolean); { set name of OpenGL texture object } procedure SetID(const aValue: Cardinal); { set new value for fMipMap } procedure SetMipMap(const aValue: TglBitmapMipMap); { set new value for target } procedure SetTarget(const aValue: Cardinal); { set new value for fAnisotrophic } procedure SetAnisotropic(const aValue: Integer); protected { create OpenGL texture object (delete exisiting object if exists) } procedure CreateID; { setup texture parameters } procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF}); { set data pointer of texture data @param aData pointer to new texture data (be carefull, aData could be freed by this function) @param aFormat format of the data stored at aData @param aWidth width of the texture data @param aHeight height of the texture data } procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; { generate texture (upload texture data to video card) @param aTestTextureSize test texture size before uploading and raise exception if something is wrong } procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract; { flip texture horizontal @returns @true in success, @false otherwise } function FlipHorz: Boolean; virtual; { flip texture vertical @returns @true in success, @false otherwise } function FlipVert: Boolean; virtual; protected property Width: Integer read GetWidth; //< the actual width of the texture property Height: Integer read GetHeight; //< the actual height of the texture property FileWidth: Integer read GetFileWidth; //< the width of the texture or 1 if the width is zero property FileHeight: Integer read GetFileHeight; //< the height of the texture or 1 if the height is zero public property ID: Cardinal read fID write SetID; //< name of the OpenGL texture object property Target: Cardinal read fTarget write SetTarget; //< texture target (e.g. GL_TEXTURE_2D) property Format: TglBitmapFormat read fFormat write SetFormat; //< format the texture data is stored in property MipMap: TglBitmapMipMap read fMipMap write SetMipMap; //< mipmap type property Anisotropic: Integer read fAnisotropic write SetAnisotropic; //< anisotropic level property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc; //< format descriptor that describes the format of the stored data property Filename: String read fFilename; //< filename the texture was load from property CustomName: String read fCustomName write SetCustomName; //< user defined name (use at will) property CustomNameW: WideString read fCustomNameW write SetCustomNameW; //< user defined name (as WideString; use at will) property CustomData: Pointer read fCustomData write SetCustomData; //< user defined data (use at will) property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree; //< delete texture object when this object is destroyed property FreeDataOnDestroy: Boolean read fFreeDataOnDestroy write SetFreeDataOnDestroy; //< free stored data when this object is destroyed property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture; //< free stored data after it is uplaoded to video card property Dimension: TglBitmapSize read fDimension; //< size of the texture property Data: PByte read fData; //< texture data (or @nil if unset) {$IFNDEF OPENGL_ES} property IsResident: GLboolean read fIsResident; //< @true if OpenGL texture object has data, @false otherwise {$ENDIF} { this method is called after the constructor and sets the default values of this object } procedure AfterConstruction; override; { this method is called before the destructor and does some cleanup } procedure BeforeDestruction; override; { splits a resource identifier into the resource and it's type @param aResource resource identifier to split and store name in @param aResType type of the resource } procedure PrepareResType(var aResource: String; var aResType: PChar); public { load a texture from a file @param aFilename file to load texuture from } procedure LoadFromFile(const aFilename: String); { load a texture from a stream @param aStream stream to load texture from } procedure LoadFromStream(const aStream: TStream); virtual; { use a function to generate texture data @param aSize size of the texture @param aFunc callback to use for generation @param aFormat format of the texture data @param aArgs user defined paramaters (use at will) } procedure LoadFromFunc(const aSize: TglBitmapSize; const aFunc: TglBitmapFunction; const aFormat: TglBitmapFormat; const aArgs: Pointer = nil); { load a texture from a resource @param aInstance resource handle @param aResource resource indentifier @param aResType resource type (if known) } procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil); { load a texture from a resource id @param aInstance resource handle @param aResource resource ID @param aResType resource type } procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); public { save texture data to a file @param aFilename filename to store texture in @param aFileType file type to store data into } procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType); { save texture data to a stream @param aFilename filename to store texture in @param aFileType file type to store data into } procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual; public { convert texture data using a user defined callback @param aFunc callback to use for converting @param aCreateTemp create a temporary buffer to use for converting @param aArgs user defined paramters (use at will) @returns @true if converting was successful, @false otherwise } function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload; { convert texture data using a user defined callback @param aSource glBitmap to read data from @param aFunc callback to use for converting @param aCreateTemp create a temporary buffer to use for converting @param aFormat format of the new data @param aArgs user defined paramters (use at will) @returns @true if converting was successful, @false otherwise } function Convert(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean; const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload; { convert texture data using a specific format @param aFormat new format of texture data @returns @true if converting was successful, @false otherwise } function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual; {$IFDEF GLB_SDL} public { assign texture data to SDL surface @param aSurface SDL surface to write data to @returns @true on success, @false otherwise } function AssignToSurface(out aSurface: PSDL_Surface): Boolean; { assign texture data from SDL surface @param aSurface SDL surface to read data from @returns @true on success, @false otherwise } function AssignFromSurface(const aSurface: PSDL_Surface): Boolean; { assign alpha channel data to SDL surface @param aSurface SDL surface to write alpha channel data to @returns @true on success, @false otherwise } function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean; { assign alpha channel data from SDL surface @param aSurface SDL surface to read data from @param aFunc callback to use for converting @param aArgs user defined parameters (use at will) @returns @true on success, @false otherwise } function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean; {$ENDIF} {$IFDEF GLB_DELPHI} public { assign texture data to TBitmap object @param aBitmap TBitmap to write data to @returns @true on success, @false otherwise } function AssignToBitmap(const aBitmap: TBitmap): Boolean; { assign texture data from TBitmap object @param aBitmap TBitmap to read data from @returns @true on success, @false otherwise } function AssignFromBitmap(const aBitmap: TBitmap): Boolean; { assign alpha channel data to TBitmap object @param aBitmap TBitmap to write data to @returns @true on success, @false otherwise } function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean; { assign alpha channel data from TBitmap object @param aBitmap TBitmap to read data from @param aFunc callback to use for converting @param aArgs user defined parameters (use at will) @returns @true on success, @false otherwise } function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean; {$ENDIF} {$IFDEF GLB_LAZARUS} public { assign texture data to TLazIntfImage object @param aImage TLazIntfImage to write data to @returns @true on success, @false otherwise } function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean; { assign texture data from TLazIntfImage object @param aImage TLazIntfImage to read data from @returns @true on success, @false otherwise } function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean; { assign alpha channel data to TLazIntfImage object @param aImage TLazIntfImage to write data to @returns @true on success, @false otherwise } function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean; { assign alpha channel data from TLazIntfImage object @param aImage TLazIntfImage to read data from @param aFunc callback to use for converting @param aArgs user defined parameters (use at will) @returns @true on success, @false otherwise } function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean; {$ENDIF} public { load alpha channel data from resource @param aInstance resource handle @param aResource resource ID @param aResType resource type @param aFunc callback to use for converting @param aArgs user defined parameters (use at will) @returns @true on success, @false otherwise } function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean; { load alpha channel data from resource ID @param aInstance resource handle @param aResourceID resource ID @param aResType resource type @param aFunc callback to use for converting @param aArgs user defined parameters (use at will) @returns @true on success, @false otherwise } function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean; { add alpha channel data from function @param aFunc callback to get data from @param aArgs user defined parameters (use at will) @returns @true on success, @false otherwise } function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual; { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap) @param aFilename file to load alpha channel data from @param aFunc callback to use for converting @param aArgs user defined parameters (use at will) @returns @true on success, @false otherwise } function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean; { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap) @param aStream stream to load alpha channel data from @param aFunc callback to use for converting @param aArgs user defined parameters (use at will) @returns @true on success, @false otherwise } function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean; { add alpha channel data from existing glBitmap object @param aBitmap TglBitmap to copy alpha channel data from @param aFunc callback to use for converting @param aArgs user defined parameters (use at will) @returns @true on success, @false otherwise } function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean; { add alpha to pixel if the pixels color is greter than the given color value @param aRed red threshold (0-255) @param aGreen green threshold (0-255) @param aBlue blue threshold (0-255) @param aDeviatation accepted deviatation (0-255) @returns @true on success, @false otherwise } function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean; { add alpha to pixel if the pixels color is greter than the given color value @param aRed red threshold (0-Range.r) @param aGreen green threshold (0-Range.g) @param aBlue blue threshold (0-Range.b) @param aDeviatation accepted deviatation (0-max(Range.rgb)) @returns @true on success, @false otherwise } function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean; { add alpha to pixel if the pixels color is greter than the given color value @param aRed red threshold (0.0-1.0) @param aGreen green threshold (0.0-1.0) @param aBlue blue threshold (0.0-1.0) @param aDeviatation accepted deviatation (0.0-1.0) @returns @true on success, @false otherwise } function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean; { add a constand alpha value to all pixels @param aAlpha alpha value to add (0-255) @returns @true on success, @false otherwise } function AddAlphaFromValue(const aAlpha: Byte): Boolean; { add a constand alpha value to all pixels @param aAlpha alpha value to add (0-max(Range.rgb)) @returns @true on success, @false otherwise } function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean; { add a constand alpha value to all pixels @param aAlpha alpha value to add (0.0-1.0) @returns @true on success, @false otherwise } function AddAlphaFromValueFloat(const aAlpha: Single): Boolean; { remove alpha channel @returns @true on success, @false otherwise } function RemoveAlpha: Boolean; virtual; public { create a clone of the current object @returns clone of this object} function Clone: TglBitmap; { invert color data (xor) @param aUseRGB xor each color channel @param aUseAlpha xor alpha channel } procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false); { free texture stored data } procedure FreeData; {$IFNDEF OPENGL_ES} { set the new value for texture border color @param aRed red color for border (0.0-1.0) @param aGreen green color for border (0.0-1.0) @param aBlue blue color for border (0.0-1.0) @param aAlpha alpha color for border (0.0-1.0) } procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single); {$ENDIF} public { fill complete texture with one color @param aRed red color for border (0-255) @param aGreen green color for border (0-255) @param aBlue blue color for border (0-255) @param aAlpha alpha color for border (0-255) } procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255); { fill complete texture with one color @param aRed red color for border (0-Range.r) @param aGreen green color for border (0-Range.g) @param aBlue blue color for border (0-Range.b) @param aAlpha alpha color for border (0-Range.a) } procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF); { fill complete texture with one color @param aRed red color for border (0.0-1.0) @param aGreen green color for border (0.0-1.0) @param aBlue blue color for border (0.0-1.0) @param aAlpha alpha color for border (0.0-1.0) } procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0); public { set new texture filer @param aMin min filter @param aMag mag filter } procedure SetFilter(const aMin, aMag: GLenum); { set new texture wrapping @param S texture wrapping for x axis @param T texture wrapping for y axis @param R texture wrapping for z axis } procedure SetWrap( const S: GLenum = GL_CLAMP_TO_EDGE; const T: GLenum = GL_CLAMP_TO_EDGE; const R: GLenum = GL_CLAMP_TO_EDGE); {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} { set new swizzle @param r swizzle for red channel @param g swizzle for green channel @param b swizzle for blue channel @param a swizzle for alpha channel } procedure SetSwizzle(const r, g, b, a: GLenum); {$IFEND} public { bind texture @param aEnableTextureUnit enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) } procedure Bind(const aEnableTextureUnit: Boolean = true); virtual; { bind texture @param aDisableTextureUnit disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) } procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual; public { constructor - created an empty texture } constructor Create; overload; { constructor - creates a texture and load it from a file @param aFilename file to load texture from } constructor Create(const aFileName: String); overload; { constructor - creates a texture and load it from a stream @param aStream stream to load texture from } constructor Create(const aStream: TStream); overload; { constructor - creates a texture with the given size, format and data @param aSize size of the texture @param aFormat format of the given data @param aData texture data - be carefull: the data will now be managed by the glBitmap object, you can control this by setting DeleteTextureOnFree, FreeDataOnDestroy and FreeDataAfterGenTexture } constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload; { constructor - creates a texture with the given size and format and uses the given callback to create the data @param aSize size of the texture @param aFormat format of the given data @param aFunc callback to use for generating the data @param aArgs user defined parameters (use at will) } constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload; { constructor - creates a texture and loads it from a resource @param aInstance resource handle @param aResource resource indentifier @param aResType resource type (if known) } constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload; { constructor - creates a texture and loads it from a resource @param aInstance resource handle @param aResourceID resource ID @param aResType resource type (if known) } constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload; private {$IFDEF GLB_SUPPORT_PNG_READ} { try to load a PNG from a stream @param aStream stream to load PNG from @returns @true on success, @false otherwise } function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF} {$ifdef GLB_SUPPORT_PNG_WRITE} { save texture data as PNG to stream @param aStream stream to save data to} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_READ} { try to load a JPEG from a stream @param aStream stream to load JPEG from @returns @true on success, @false otherwise } function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_WRITE} { save texture data as JPEG to stream @param aStream stream to save data to} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF} { try to load a RAW image from a stream @param aStream stream to load RAW image from @returns @true on success, @false otherwise } function LoadRAW(const aStream: TStream): Boolean; { save texture data as RAW image to stream @param aStream stream to save data to} procedure SaveRAW(const aStream: TStream); { try to load a BMP from a stream @param aStream stream to load BMP from @returns @true on success, @false otherwise } function LoadBMP(const aStream: TStream): Boolean; { save texture data as BMP to stream @param aStream stream to save data to} procedure SaveBMP(const aStream: TStream); { try to load a TGA from a stream @param aStream stream to load TGA from @returns @true on success, @false otherwise } function LoadTGA(const aStream: TStream): Boolean; { save texture data as TGA to stream @param aStream stream to save data to} procedure SaveTGA(const aStream: TStream); { try to load a DDS from a stream @param aStream stream to load DDS from @returns @true on success, @false otherwise } function LoadDDS(const aStream: TStream): Boolean; { save texture data as DDS to stream @param aStream stream to save data to} procedure SaveDDS(const aStream: TStream); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// {$IF NOT DEFINED(OPENGL_ES)} { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D } TglBitmap1D = class(TglBitmap) protected { set data pointer of texture data @param aData pointer to new texture data (be carefull, aData could be freed by this function) @param aFormat format of the data stored at aData @param aWidth width of the texture data @param aHeight height of the texture data } procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer = - 1; const aHeight: Integer = - 1); override; { upload the texture data to video card @param aBuildWithGlu use glu functions to build mipmaps } procedure UploadData(const aBuildWithGlu: Boolean); public property Width; //< actual with of the texture { this method is called after constructor and initializes the object } procedure AfterConstruction; override; { flip texture horizontally @returns @true on success, @fals otherwise } function FlipHorz: Boolean; override; { generate texture (create texture object if not exist, set texture parameters and upload data @param aTestTextureSize check the size of the texture and throw exception if something is wrong } procedure GenTexture(const aTestTextureSize: Boolean = true); override; end; {$IFEND} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D) } TglBitmap2D = class(TglBitmap) protected fLines: array of PByte; //< array to store scanline entry points in { get a specific scanline @param aIndex index of the scanline to return @returns scanline at position aIndex or @nil } function GetScanline(const aIndex: Integer): Pointer; { set data pointer of texture data @param aData pointer to new texture data (be carefull, aData could be freed by this function) @param aFormat format of the data stored at aData @param aWidth width of the texture data @param aHeight height of the texture data } procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer = - 1; const aHeight: Integer = - 1); override; { upload the texture data to video card @param aTarget target o upload data to (e.g. GL_TEXTURE_2D) @param aBuildWithGlu use glu functions to build mipmaps } procedure UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF}); public property Width; //< actual width of the texture property Height; //< actual height of the texture property Scanline[const aIndex: Integer]: Pointer read GetScanline; //< scanline to access texture data directly { this method is called after constructor and initializes the object } procedure AfterConstruction; override; { copy a part of the frame buffer top the texture @param aTop topmost pixel to copy @param aLeft leftmost pixel to copy @param aRight rightmost pixel to copy @param aBottom bottommost pixel to copy @param aFormat format to store data in } procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat); {$IFNDEF OPENGL_ES} { downlaod texture data from OpenGL texture object } procedure GetDataFromTexture; {$ENDIF} { generate texture (create texture object if not exist, set texture parameters and upload data) @param aTestTextureSize check the size of the texture and throw exception if something is wrong } procedure GenTexture(const aTestTextureSize: Boolean = true); override; { flip texture horizontally @returns @true on success, @false otherwise } function FlipHorz: Boolean; override; { flip texture vertically @returns @true on success, @false otherwise } function FlipVert: Boolean; override; { create normal map from texture data @param aFunc normal map function to generate normalmap with @param aScale scale of the normale stored in the normal map @param aUseAlpha generate normalmap from alpha channel data (if present) } procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3; const aScale: Single = 2; const aUseAlpha: Boolean = false); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)} { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP) } TglBitmapCubeMap = class(TglBitmap2D) protected {$IFNDEF OPENGL_ES} fGenMode: Integer; //< generation mode for the cube map (e.g. GL_REFLECTION_MAP) {$ENDIF} { generate texture (create texture object if not exist, set texture parameters and upload data do not call directly for cubemaps, use GenerateCubeMap instead @param aTestTextureSize check the size of the texture and throw exception if something is wrong } procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce; public { this method is called after constructor and initializes the object } procedure AfterConstruction; override; { generate texture (create texture object if not exist, set texture parameters and upload data @param aCubeTarget cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X) @param aTestTextureSize check the size of the texture and throw exception if something is wrong } procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true); { bind texture @param aEnableTexCoordsGen enable cube map generator @param aEnableTextureUnit enable texture unit } procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual; { unbind texture @param aDisableTexCoordsGen disable cube map generator @param aDisableTextureUnit disable texture unit } procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual; end; {$IFEND} {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// { wrapper class for cube normal maps } TglBitmapNormalMap = class(TglBitmapCubeMap) public { this method is called after constructor and initializes the object } procedure AfterConstruction; override; { create cube normal map from texture data and upload it to video card @param aSize size of each cube map texture @param aTestTextureSize check texture size when uploading and throw exception if something is wrong } procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true); end; {$IFEND} const NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0); procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean); procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean); procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap); procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat); procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer); procedure glBitmapSetDefaultWrap( const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE); {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA); {$IFEND} function glBitmapGetDefaultDeleteTextureOnFree: Boolean; function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean; function glBitmapGetDefaultMipmap: TglBitmapMipMap; function glBitmapGetDefaultFormat: TglBitmapFormat; procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal); procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal); {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum); {$IFEND} function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize; function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition; function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub; function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui; function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul; function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean; function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean; function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D; {$IFDEF GLB_DELPHI} function CreateGrayPalette: HPALETTE; {$ENDIF} implementation uses Math, syncobjs, typinfo {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND}; var glBitmapDefaultDeleteTextureOnFree: Boolean; glBitmapDefaultFreeDataAfterGenTextures: Boolean; glBitmapDefaultFormat: TglBitmapFormat; glBitmapDefaultMipmap: TglBitmapMipMap; glBitmapDefaultFilterMin: Cardinal; glBitmapDefaultFilterMag: Cardinal; glBitmapDefaultWrapS: Cardinal; glBitmapDefaultWrapT: Cardinal; glBitmapDefaultWrapR: Cardinal; glDefaultSwizzle: array[0..3] of GLenum; //////////////////////////////////////////////////////////////////////////////////////////////////// type TFormatDescriptor = class(TglBitmapFormatDescriptor) public procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract; function GetSize(const aSize: TglBitmapSize): Integer; overload; virtual; function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual; function CreateMappingData: Pointer; virtual; procedure FreeMappingData(var aMappingData: Pointer); virtual; function IsEmpty: Boolean; virtual; function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual; procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual; constructor Create; virtual; public class procedure Init; class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor; class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor; class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor; class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor; class procedure Clear; class procedure Finalize; end; TFormatDescriptorClass = class of TFormatDescriptor; TfdEmpty = class(TFormatDescriptor); ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse) procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse) procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse) procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdARGBus4 = class(TfdRGBus3) //4* unsigned short procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse) procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse) procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdAlpha4ub1 = class(TfdAlphaUB1) procedure SetValues; override; end; TfdAlpha8ub1 = class(TfdAlphaUB1) procedure SetValues; override; end; TfdAlpha16us1 = class(TfdAlphaUS1) procedure SetValues; override; end; TfdLuminance4ub1 = class(TfdLuminanceUB1) procedure SetValues; override; end; TfdLuminance8ub1 = class(TfdLuminanceUB1) procedure SetValues; override; end; TfdLuminance16us1 = class(TfdLuminanceUS1) procedure SetValues; override; end; TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2) procedure SetValues; override; end; TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2) procedure SetValues; override; end; TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2) procedure SetValues; override; end; TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2) procedure SetValues; override; end; TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2) procedure SetValues; override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdR3G3B2ub1 = class(TfdUniversalUB1) procedure SetValues; override; end; TfdRGBX4us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdXRGB4us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdR5G6B5us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdRGB5X1us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdX1RGB5us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdRGB8ub3 = class(TfdRGBub3) procedure SetValues; override; end; TfdRGBX8ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdXRGB8ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdRGB10X2ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdX2RGB10ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdRGB16us3 = class(TfdRGBus3) procedure SetValues; override; end; TfdRGBA4us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdARGB4us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdRGB5A1us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdA1RGB5us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdRGBA8ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdARGB8ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdRGBA8ub4 = class(TfdRGBAub4) procedure SetValues; override; end; TfdRGB10A2ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdA2RGB10ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdRGBA16us4 = class(TfdRGBAus4) procedure SetValues; override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TfdBGRX4us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdXBGR4us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdB5G6R5us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdBGR5X1us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdX1BGR5us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdBGR8ub3 = class(TfdBGRub3) procedure SetValues; override; end; TfdBGRX8ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdXBGR8ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdBGR10X2ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdX2BGR10ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdBGR16us3 = class(TfdBGRus3) procedure SetValues; override; end; TfdBGRA4us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdABGR4us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdBGR5A1us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdA1BGR5us1 = class(TfdUniversalUS1) procedure SetValues; override; end; TfdBGRA8ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdABGR8ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdBGRA8ub4 = class(TfdBGRAub4) procedure SetValues; override; end; TfdBGR10A2ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdA2BGR10ui1 = class(TfdUniversalUI1) procedure SetValues; override; end; TfdBGRA16us4 = class(TfdBGRAus4) procedure SetValues; override; end; TfdDepth16us1 = class(TfdDepthUS1) procedure SetValues; override; end; TfdDepth24ui1 = class(TfdDepthUI1) procedure SetValues; override; end; TfdDepth32ui1 = class(TfdDepthUI1) procedure SetValues; override; end; TfdS3tcDtx1RGBA = class(TFormatDescriptor) procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; procedure SetValues; override; end; TfdS3tcDtx3RGBA = class(TFormatDescriptor) procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; procedure SetValues; override; end; TfdS3tcDtx5RGBA = class(TFormatDescriptor) procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; procedure SetValues; override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TbmpBitfieldFormat = class(TFormatDescriptor) public procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload; procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload; procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TbmpColorTableEnty = packed record b, g, r, a: Byte; end; TbmpColorTable = array of TbmpColorTableEnty; TbmpColorTableFormat = class(TFormatDescriptor) private fBitsPerPixel: Integer; fColorTable: TbmpColorTable; protected procedure SetValues; override; public property ColorTable: TbmpColorTable read fColorTable write fColorTable; property BitsPerPixel: Integer read fBitsPerPixel write fBitsPerPixel; procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload; procedure CalcValues; procedure CreateColorTable; procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override; destructor Destroy; override; end; const LUMINANCE_WEIGHT_R = 0.30; LUMINANCE_WEIGHT_G = 0.59; LUMINANCE_WEIGHT_B = 0.11; ALPHA_WEIGHT_R = 0.30; ALPHA_WEIGHT_G = 0.59; ALPHA_WEIGHT_B = 0.11; DEPTH_WEIGHT_R = 0.333333333; DEPTH_WEIGHT_G = 0.333333333; DEPTH_WEIGHT_B = 0.333333333; FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = ( TfdEmpty, TfdAlpha4ub1, TfdAlpha8ub1, TfdAlpha16us1, TfdLuminance4ub1, TfdLuminance8ub1, TfdLuminance16us1, TfdLuminance4Alpha4ub2, TfdLuminance6Alpha2ub2, TfdLuminance8Alpha8ub2, TfdLuminance12Alpha4us2, TfdLuminance16Alpha16us2, TfdR3G3B2ub1, TfdRGBX4us1, TfdXRGB4us1, TfdR5G6B5us1, TfdRGB5X1us1, TfdX1RGB5us1, TfdRGB8ub3, TfdRGBX8ui1, TfdXRGB8ui1, TfdRGB10X2ui1, TfdX2RGB10ui1, TfdRGB16us3, TfdRGBA4us1, TfdARGB4us1, TfdRGB5A1us1, TfdA1RGB5us1, TfdRGBA8ui1, TfdARGB8ui1, TfdRGBA8ub4, TfdRGB10A2ui1, TfdA2RGB10ui1, TfdRGBA16us4, TfdBGRX4us1, TfdXBGR4us1, TfdB5G6R5us1, TfdBGR5X1us1, TfdX1BGR5us1, TfdBGR8ub3, TfdBGRX8ui1, TfdXBGR8ui1, TfdBGR10X2ui1, TfdX2BGR10ui1, TfdBGR16us3, TfdBGRA4us1, TfdABGR4us1, TfdBGR5A1us1, TfdA1BGR5us1, TfdBGRA8ui1, TfdABGR8ui1, TfdBGRA8ub4, TfdBGR10A2ui1, TfdA2BGR10ui1, TfdBGRA16us4, TfdDepth16us1, TfdDepth24ui1, TfdDepth32ui1, TfdS3tcDtx1RGBA, TfdS3tcDtx3RGBA, TfdS3tcDtx5RGBA ); var FormatDescriptorCS: TCriticalSection; FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat); begin inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat))); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat); begin inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat))); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize; begin result.Fields := []; if (X >= 0) then result.Fields := result.Fields + [ffX]; if (Y >= 0) then result.Fields := result.Fields + [ffY]; result.X := Max(0, X); result.Y := Max(0, Y); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition; begin result := glBitmapSize(X, Y); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub; begin result.r := r; result.g := g; result.b := b; result.a := a; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui; begin result.r := r; result.g := g; result.b := b; result.a := a; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul; begin result.r := r; result.g := g; result.b := b; result.a := a; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean; var i: Integer; begin result := false; for i := 0 to high(r1.arr) do if (r1.arr[i] <> r2.arr[i]) then exit; result := true; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean; var i: Integer; begin result := false; for i := 0 to high(r1.arr) do if (r1.arr[i] <> r2.arr[i]) then exit; result := true; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D; var desc: TFormatDescriptor; p, tmp: PByte; x, y, i: Integer; md: Pointer; px: TglBitmapPixelData; begin result := nil; desc := TFormatDescriptor.Get(aFormat); if (desc.IsCompressed) or (desc.glFormat = 0) then exit; p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel md := desc.CreateMappingData; try tmp := p; desc.PreparePixel(px); for y := 0 to 4 do for x := 0 to 4 do begin px.Data := glBitmapRec4ui(0, 0, 0, 0); for i := 0 to 3 do begin if ((y < 3) and (y = i)) or ((y = 3) and (i < 3)) or ((y = 4) and (i = 3)) then px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x) else if ((y < 4) and (i = 3)) or ((y = 4) and (i < 3)) then px.Data.arr[i] := px.Range.arr[i] else px.Data.arr[i] := 0; //px.Range.arr[i]; end; desc.Map(px, tmp, md); end; finally desc.FreeMappingData(md); end; result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p); result.FreeDataOnDestroy := true; result.FreeDataAfterGenTexture := false; result.SetFilter(GL_NEAREST, GL_NEAREST); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub; begin result.r := r; result.g := g; result.b := b; result.a := a; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes; begin result := []; if (aFormat in [ //8bpp tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1, //16bpp tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2, tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1, tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1, //24bpp tfBGR8ub3, tfRGB8ub3, //32bpp tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1, tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1]) then result := result + [ ftBMP ]; if (aFormat in [ //8bbp tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, //16bbp tfAlpha16us1, tfLuminance16us1, tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2, tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1, //24bbp tfBGR8ub3, //32bbp tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1, tfDepth24ui1, tfDepth32ui1]) then result := result + [ftTGA]; if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then result := result + [ftDDS]; {$IFDEF GLB_SUPPORT_PNG_WRITE} if aFormat in [ tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2, tfRGB8ub3, tfRGBA8ui1, tfBGR8ub3, tfBGRA8ui1] then result := result + [ftPNG]; {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_WRITE} if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then result := result + [ftJPEG]; {$ENDIF} end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function IsPowerOfTwo(aNumber: Integer): Boolean; begin while (aNumber and 1) = 0 do aNumber := aNumber shr 1; result := aNumber = 1; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function GetTopMostBit(aBitSet: QWord): Integer; begin result := 0; while aBitSet > 0 do begin inc(result); aBitSet := aBitSet shr 1; end; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function CountSetBits(aBitSet: QWord): Integer; begin result := 0; while aBitSet > 0 do begin if (aBitSet and 1) = 1 then inc(result); aBitSet := aBitSet shr 1; end; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal; begin result := Trunc( LUMINANCE_WEIGHT_R * aPixel.Data.r + LUMINANCE_WEIGHT_G * aPixel.Data.g + LUMINANCE_WEIGHT_B * aPixel.Data.b); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal; begin result := Trunc( DEPTH_WEIGHT_R * aPixel.Data.r + DEPTH_WEIGHT_G * aPixel.Data.g + DEPTH_WEIGHT_B * aPixel.Data.b); end; {$IFDEF GLB_SDL_IMAGE} ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // SDL Image Helper ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl; begin result := TStream(context^.unknown.data1).Seek(offset, whence); end; function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl; begin result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum); end; function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl; begin result := TStream(context^.unknown.data1).Write(Ptr^, size * num); end; function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl; begin result := 0; end; function glBitmapCreateRWops(Stream: TStream): PSDL_RWops; begin result := SDL_AllocRW; if result = nil then raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.'); result^.seek := glBitmapRWseek; result^.read := glBitmapRWread; result^.write := glBitmapRWwrite; result^.close := glBitmapRWclose; result^.unknown.data1 := Stream; end; {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean); begin glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean); begin glBitmapDefaultFreeDataAfterGenTextures := aFreeData; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap); begin glBitmapDefaultMipmap := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat); begin glBitmapDefaultFormat := aFormat; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer); begin glBitmapDefaultFilterMin := aMin; glBitmapDefaultFilterMag := aMag; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE); begin glBitmapDefaultWrapS := S; glBitmapDefaultWrapT := T; glBitmapDefaultWrapR := R; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA); begin glDefaultSwizzle[0] := r; glDefaultSwizzle[1] := g; glDefaultSwizzle[2] := b; glDefaultSwizzle[3] := a; end; {$IFEND} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapGetDefaultDeleteTextureOnFree: Boolean; begin result := glBitmapDefaultDeleteTextureOnFree; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean; begin result := glBitmapDefaultFreeDataAfterGenTextures; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapGetDefaultMipmap: TglBitmapMipMap; begin result := glBitmapDefaultMipmap; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmapGetDefaultFormat: TglBitmapFormat; begin result := glBitmapDefaultFormat; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal); begin aMin := glBitmapDefaultFilterMin; aMag := glBitmapDefaultFilterMag; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal); begin S := glBitmapDefaultWrapS; T := glBitmapDefaultWrapT; R := glBitmapDefaultWrapR; end; {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum); begin r := glDefaultSwizzle[0]; g := glDefaultSwizzle[1]; b := glDefaultSwizzle[2]; a := glDefaultSwizzle[3]; end; {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TFormatDescriptor/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer; var w, h: Integer; begin if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin w := Max(1, aSize.X); h := Max(1, aSize.Y); result := GetSize(w, h); end else result := 0; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer; begin result := 0; if (aWidth <= 0) or (aHeight <= 0) then exit; result := Ceil(aWidth * aHeight * BytesPerPixel); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.CreateMappingData: Pointer; begin result := nil; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer); begin //DUMMY end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.IsEmpty: Boolean; begin result := (fFormat = tfEmpty); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean; var i: Integer; m: TglBitmapRec4ul; begin result := false; if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then raise EglBitmap.Create('FormatCheckFormat - All Masks are 0'); m := Mask; for i := 0 to 3 do if (aMask.arr[i] <> m.arr[i]) then exit; result := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData); begin FillChar(aPixel{%H-}, SizeOf(aPixel), 0); aPixel.Data := Range; aPixel.Format := fFormat; aPixel.Range := Range; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TFormatDescriptor.Create; begin inherited Create; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdAlpha_UB1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin aData^ := aPixel.Data.a; inc(aData); end; procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.r := 0; aPixel.Data.g := 0; aPixel.Data.b := 0; aPixel.Data.a := aData^; inc(aData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdLuminance_UB1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin aData^ := LuminanceWeight(aPixel); inc(aData); end; procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.r := aData^; aPixel.Data.g := aData^; aPixel.Data.b := aData^; aPixel.Data.a := 0; inc(aData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdUniversal_UB1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); var i: Integer; begin aData^ := 0; for i := 0 to 3 do if (Range.arr[i] > 0) then aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]); inc(aData); end; procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); var i: Integer; begin for i := 0 to 3 do aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i]; inc(aData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdLuminanceAlpha_UB2/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin inherited Map(aPixel, aData, aMapData); aData^ := aPixel.Data.a; inc(aData); end; procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin inherited Unmap(aData, aPixel, aMapData); aPixel.Data.a := aData^; inc(aData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdRGB_UB3////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin aData^ := aPixel.Data.r; inc(aData); aData^ := aPixel.Data.g; inc(aData); aData^ := aPixel.Data.b; inc(aData); end; procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.r := aData^; inc(aData); aPixel.Data.g := aData^; inc(aData); aPixel.Data.b := aData^; inc(aData); aPixel.Data.a := 0; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdBGR_UB3////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin aData^ := aPixel.Data.b; inc(aData); aData^ := aPixel.Data.g; inc(aData); aData^ := aPixel.Data.r; inc(aData); end; procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.b := aData^; inc(aData); aPixel.Data.g := aData^; inc(aData); aPixel.Data.r := aData^; inc(aData); aPixel.Data.a := 0; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdRGBA_UB4////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin inherited Map(aPixel, aData, aMapData); aData^ := aPixel.Data.a; inc(aData); end; procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin inherited Unmap(aData, aPixel, aMapData); aPixel.Data.a := aData^; inc(aData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdBGRA_UB4////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin inherited Map(aPixel, aData, aMapData); aData^ := aPixel.Data.a; inc(aData); end; procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin inherited Unmap(aData, aPixel, aMapData); aPixel.Data.a := aData^; inc(aData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdAlpha_US1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := aPixel.Data.a; inc(aData, 2); end; procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.r := 0; aPixel.Data.g := 0; aPixel.Data.b := 0; aPixel.Data.a := PWord(aData)^; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdLuminance_US1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := LuminanceWeight(aPixel); inc(aData, 2); end; procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.r := PWord(aData)^; aPixel.Data.g := PWord(aData)^; aPixel.Data.b := PWord(aData)^; aPixel.Data.a := 0; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdUniversal_US1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); var i: Integer; begin PWord(aData)^ := 0; for i := 0 to 3 do if (Range.arr[i] > 0) then PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]); inc(aData, 2); end; procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); var i: Integer; begin for i := 0 to 3 do aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i]; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdDepth_US1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := DepthWeight(aPixel); inc(aData, 2); end; procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.r := PWord(aData)^; aPixel.Data.g := PWord(aData)^; aPixel.Data.b := PWord(aData)^; aPixel.Data.a := PWord(aData)^;; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdLuminanceAlpha_US2/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin inherited Map(aPixel, aData, aMapData); PWord(aData)^ := aPixel.Data.a; inc(aData, 2); end; procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin inherited Unmap(aData, aPixel, aMapData); aPixel.Data.a := PWord(aData)^; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdRGB_US3////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := aPixel.Data.r; inc(aData, 2); PWord(aData)^ := aPixel.Data.g; inc(aData, 2); PWord(aData)^ := aPixel.Data.b; inc(aData, 2); end; procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.r := PWord(aData)^; inc(aData, 2); aPixel.Data.g := PWord(aData)^; inc(aData, 2); aPixel.Data.b := PWord(aData)^; inc(aData, 2); aPixel.Data.a := 0; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdBGR_US3////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := aPixel.Data.b; inc(aData, 2); PWord(aData)^ := aPixel.Data.g; inc(aData, 2); PWord(aData)^ := aPixel.Data.r; inc(aData, 2); end; procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.b := PWord(aData)^; inc(aData, 2); aPixel.Data.g := PWord(aData)^; inc(aData, 2); aPixel.Data.r := PWord(aData)^; inc(aData, 2); aPixel.Data.a := 0; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdRGBA_US4///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin inherited Map(aPixel, aData, aMapData); PWord(aData)^ := aPixel.Data.a; inc(aData, 2); end; procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin inherited Unmap(aData, aPixel, aMapData); aPixel.Data.a := PWord(aData)^; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdARGB_US4///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := aPixel.Data.a; inc(aData, 2); inherited Map(aPixel, aData, aMapData); end; procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.a := PWord(aData)^; inc(aData, 2); inherited Unmap(aData, aPixel, aMapData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdBGRA_US4///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin inherited Map(aPixel, aData, aMapData); PWord(aData)^ := aPixel.Data.a; inc(aData, 2); end; procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin inherited Unmap(aData, aPixel, aMapData); aPixel.Data.a := PWord(aData)^; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdABGR_US4///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PWord(aData)^ := aPixel.Data.a; inc(aData, 2); inherited Map(aPixel, aData, aMapData); end; procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.a := PWord(aData)^; inc(aData, 2); inherited Unmap(aData, aPixel, aMapData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdUniversal_UI1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); var i: Integer; begin PCardinal(aData)^ := 0; for i := 0 to 3 do if (Range.arr[i] > 0) then PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]); inc(aData, 4); end; procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); var i: Integer; begin for i := 0 to 3 do aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i]; inc(aData, 2); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdDepth_UI1//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin PCardinal(aData)^ := DepthWeight(aPixel); inc(aData, 4); end; procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin aPixel.Data.r := PCardinal(aData)^; aPixel.Data.g := PCardinal(aData)^; aPixel.Data.b := PCardinal(aData)^; aPixel.Data.a := PCardinal(aData)^; inc(aData, 4); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdAlpha4ub1.SetValues; begin inherited SetValues; fBitsPerPixel := 8; fFormat := tfAlpha4ub1; fWithAlpha := tfAlpha4ub1; fPrecision := glBitmapRec4ub(0, 0, 0, 8); fShift := glBitmapRec4ub(0, 0, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfAlpha4ub1; fglFormat := GL_ALPHA; fglInternalFormat := GL_ALPHA4; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := tfAlpha8ub1; {$ENDIF} end; procedure TfdAlpha8ub1.SetValues; begin inherited SetValues; fBitsPerPixel := 8; fFormat := tfAlpha8ub1; fWithAlpha := tfAlpha8ub1; fPrecision := glBitmapRec4ub(0, 0, 0, 8); fShift := glBitmapRec4ub(0, 0, 0, 0); fOpenGLFormat := tfAlpha8ub1; fglFormat := GL_ALPHA; fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF}; fglDataFormat := GL_UNSIGNED_BYTE; end; procedure TfdAlpha16us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfAlpha16us1; fWithAlpha := tfAlpha16us1; fPrecision := glBitmapRec4ub(0, 0, 0, 16); fShift := glBitmapRec4ub(0, 0, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfAlpha16us1; fglFormat := GL_ALPHA; fglInternalFormat := GL_ALPHA16; fglDataFormat := GL_UNSIGNED_SHORT; {$ELSE} fOpenGLFormat := tfAlpha8ub1; {$ENDIF} end; procedure TfdLuminance4ub1.SetValues; begin inherited SetValues; fBitsPerPixel := 8; fFormat := tfLuminance4ub1; fWithAlpha := tfLuminance4Alpha4ub2; fWithoutAlpha := tfLuminance4ub1; fPrecision := glBitmapRec4ub(8, 8, 8, 0); fShift := glBitmapRec4ub(0, 0, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfLuminance4ub1; fglFormat := GL_LUMINANCE; fglInternalFormat := GL_LUMINANCE4; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := tfLuminance8ub1; {$ENDIF} end; procedure TfdLuminance8ub1.SetValues; begin inherited SetValues; fBitsPerPixel := 8; fFormat := tfLuminance8ub1; fWithAlpha := tfLuminance8Alpha8ub2; fWithoutAlpha := tfLuminance8ub1; fOpenGLFormat := tfLuminance8ub1; fPrecision := glBitmapRec4ub(8, 8, 8, 0); fShift := glBitmapRec4ub(0, 0, 0, 0); fglFormat := GL_LUMINANCE; fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF}; fglDataFormat := GL_UNSIGNED_BYTE; end; procedure TfdLuminance16us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfLuminance16us1; fWithAlpha := tfLuminance16Alpha16us2; fWithoutAlpha := tfLuminance16us1; fPrecision := glBitmapRec4ub(16, 16, 16, 0); fShift := glBitmapRec4ub( 0, 0, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfLuminance16us1; fglFormat := GL_LUMINANCE; fglInternalFormat := GL_LUMINANCE16; fglDataFormat := GL_UNSIGNED_SHORT; {$ELSE} fOpenGLFormat := tfLuminance8ub1; {$ENDIF} end; procedure TfdLuminance4Alpha4ub2.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfLuminance4Alpha4ub2; fWithAlpha := tfLuminance4Alpha4ub2; fWithoutAlpha := tfLuminance4ub1; fPrecision := glBitmapRec4ub(8, 8, 8, 8); fShift := glBitmapRec4ub(0, 0, 0, 8); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfLuminance4Alpha4ub2; fglFormat := GL_LUMINANCE_ALPHA; fglInternalFormat := GL_LUMINANCE4_ALPHA4; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := tfLuminance8Alpha8ub2; {$ENDIF} end; procedure TfdLuminance6Alpha2ub2.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfLuminance6Alpha2ub2; fWithAlpha := tfLuminance6Alpha2ub2; fWithoutAlpha := tfLuminance8ub1; fPrecision := glBitmapRec4ub(8, 8, 8, 8); fShift := glBitmapRec4ub(0, 0, 0, 8); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfLuminance6Alpha2ub2; fglFormat := GL_LUMINANCE_ALPHA; fglInternalFormat := GL_LUMINANCE6_ALPHA2; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := tfLuminance8Alpha8ub2; {$ENDIF} end; procedure TfdLuminance8Alpha8ub2.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfLuminance8Alpha8ub2; fWithAlpha := tfLuminance8Alpha8ub2; fWithoutAlpha := tfLuminance8ub1; fOpenGLFormat := tfLuminance8Alpha8ub2; fPrecision := glBitmapRec4ub(8, 8, 8, 8); fShift := glBitmapRec4ub(0, 0, 0, 8); fglFormat := GL_LUMINANCE_ALPHA; fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF}; fglDataFormat := GL_UNSIGNED_BYTE; end; procedure TfdLuminance12Alpha4us2.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfLuminance12Alpha4us2; fWithAlpha := tfLuminance12Alpha4us2; fWithoutAlpha := tfLuminance16us1; fPrecision := glBitmapRec4ub(16, 16, 16, 16); fShift := glBitmapRec4ub( 0, 0, 0, 16); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfLuminance12Alpha4us2; fglFormat := GL_LUMINANCE_ALPHA; fglInternalFormat := GL_LUMINANCE12_ALPHA4; fglDataFormat := GL_UNSIGNED_SHORT; {$ELSE} fOpenGLFormat := tfLuminance8Alpha8ub2; {$ENDIF} end; procedure TfdLuminance16Alpha16us2.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfLuminance16Alpha16us2; fWithAlpha := tfLuminance16Alpha16us2; fWithoutAlpha := tfLuminance16us1; fPrecision := glBitmapRec4ub(16, 16, 16, 16); fShift := glBitmapRec4ub( 0, 0, 0, 16); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfLuminance16Alpha16us2; fglFormat := GL_LUMINANCE_ALPHA; fglInternalFormat := GL_LUMINANCE16_ALPHA16; fglDataFormat := GL_UNSIGNED_SHORT; {$ELSE} fOpenGLFormat := tfLuminance8Alpha8ub2; {$ENDIF} end; procedure TfdR3G3B2ub1.SetValues; begin inherited SetValues; fBitsPerPixel := 8; fFormat := tfR3G3B2ub1; fWithAlpha := tfRGBA4us1; fWithoutAlpha := tfR3G3B2ub1; fRGBInverted := tfEmpty; fPrecision := glBitmapRec4ub(3, 3, 2, 0); fShift := glBitmapRec4ub(5, 2, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfR3G3B2ub1; fglFormat := GL_RGB; fglInternalFormat := GL_R3_G3_B2; fglDataFormat := GL_UNSIGNED_BYTE_3_3_2; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdRGBX4us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfRGBX4us1; fWithAlpha := tfRGBA4us1; fWithoutAlpha := tfRGBX4us1; fRGBInverted := tfBGRX4us1; fPrecision := glBitmapRec4ub( 4, 4, 4, 0); fShift := glBitmapRec4ub(12, 8, 4, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfRGBX4us1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdXRGB4us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfXRGB4us1; fWithAlpha := tfARGB4us1; fWithoutAlpha := tfXRGB4us1; fRGBInverted := tfXBGR4us1; fPrecision := glBitmapRec4ub(4, 4, 4, 0); fShift := glBitmapRec4ub(8, 4, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfXRGB4us1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdR5G6B5us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfR5G6B5us1; fWithAlpha := tfRGB5A1us1; fWithoutAlpha := tfR5G6B5us1; fRGBInverted := tfB5G6R5us1; fPrecision := glBitmapRec4ub( 5, 6, 5, 0); fShift := glBitmapRec4ub(11, 5, 0, 0); {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)} fOpenGLFormat := tfR5G6B5us1; fglFormat := GL_RGB; fglInternalFormat := GL_RGB565; fglDataFormat := GL_UNSIGNED_SHORT_5_6_5; {$ELSE} fOpenGLFormat := tfRGB8ub3; {$IFEND} end; procedure TfdRGB5X1us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfRGB5X1us1; fWithAlpha := tfRGB5A1us1; fWithoutAlpha := tfRGB5X1us1; fRGBInverted := tfBGR5X1us1; fPrecision := glBitmapRec4ub( 5, 5, 5, 0); fShift := glBitmapRec4ub(11, 6, 1, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfRGB5X1us1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB5; fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdX1RGB5us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfX1RGB5us1; fWithAlpha := tfA1RGB5us1; fWithoutAlpha := tfX1RGB5us1; fRGBInverted := tfX1BGR5us1; fPrecision := glBitmapRec4ub( 5, 5, 5, 0); fShift := glBitmapRec4ub(10, 5, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfX1RGB5us1; fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB5; fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdRGB8ub3.SetValues; begin inherited SetValues; fBitsPerPixel := 24; fFormat := tfRGB8ub3; fWithAlpha := tfRGBA8ub4; fWithoutAlpha := tfRGB8ub3; fRGBInverted := tfBGR8ub3; fPrecision := glBitmapRec4ub(8, 8, 8, 0); fShift := glBitmapRec4ub(0, 8, 16, 0); fOpenGLFormat := tfRGB8ub3; fglFormat := GL_RGB; fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND}; fglDataFormat := GL_UNSIGNED_BYTE; end; procedure TfdRGBX8ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfRGBX8ui1; fWithAlpha := tfRGBA8ui1; fWithoutAlpha := tfRGBX8ui1; fRGBInverted := tfBGRX8ui1; fPrecision := glBitmapRec4ub( 8, 8, 8, 0); fShift := glBitmapRec4ub(24, 16, 8, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfRGBX8ui1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8; {$ELSE} fOpenGLFormat := tfRGB8ub3; {$ENDIF} end; procedure TfdXRGB8ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfXRGB8ui1; fWithAlpha := tfXRGB8ui1; fWithoutAlpha := tfXRGB8ui1; fOpenGLFormat := tfXRGB8ui1; fRGBInverted := tfXBGR8ui1; fPrecision := glBitmapRec4ub( 8, 8, 8, 0); fShift := glBitmapRec4ub(16, 8, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfXRGB8ui1; fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV; {$ELSE} fOpenGLFormat := tfRGB8ub3; {$ENDIF} end; procedure TfdRGB10X2ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfRGB10X2ui1; fWithAlpha := tfRGB10A2ui1; fWithoutAlpha := tfRGB10X2ui1; fRGBInverted := tfBGR10X2ui1; fPrecision := glBitmapRec4ub(10, 10, 10, 0); fShift := glBitmapRec4ub(22, 12, 2, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfRGB10X2ui1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB10; fglDataFormat := GL_UNSIGNED_INT_10_10_10_2; {$ELSE} fOpenGLFormat := tfRGB16us3; {$ENDIF} end; procedure TfdX2RGB10ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfX2RGB10ui1; fWithAlpha := tfA2RGB10ui1; fWithoutAlpha := tfX2RGB10ui1; fRGBInverted := tfX2BGR10ui1; fPrecision := glBitmapRec4ub(10, 10, 10, 0); fShift := glBitmapRec4ub(20, 10, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfX2RGB10ui1; fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB10; fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV; {$ELSE} fOpenGLFormat := tfRGB16us3; {$ENDIF} end; procedure TfdRGB16us3.SetValues; begin inherited SetValues; fBitsPerPixel := 48; fFormat := tfRGB16us3; fWithAlpha := tfRGBA16us4; fWithoutAlpha := tfRGB16us3; fRGBInverted := tfBGR16us3; fPrecision := glBitmapRec4ub(16, 16, 16, 0); fShift := glBitmapRec4ub( 0, 16, 32, 0); {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} fOpenGLFormat := tfRGB16us3; fglFormat := GL_RGB; fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF}; fglDataFormat := GL_UNSIGNED_SHORT; {$ELSE} fOpenGLFormat := tfRGB8ub3; {$IFEND} end; procedure TfdRGBA4us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfRGBA4us1; fWithAlpha := tfRGBA4us1; fWithoutAlpha := tfRGBX4us1; fOpenGLFormat := tfRGBA4us1; fRGBInverted := tfBGRA4us1; fPrecision := glBitmapRec4ub( 4, 4, 4, 4); fShift := glBitmapRec4ub(12, 8, 4, 0); fglFormat := GL_RGBA; fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND}; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4; end; procedure TfdARGB4us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfARGB4us1; fWithAlpha := tfARGB4us1; fWithoutAlpha := tfXRGB4us1; fRGBInverted := tfABGR4us1; fPrecision := glBitmapRec4ub( 4, 4, 4, 4); fShift := glBitmapRec4ub( 8, 4, 0, 12); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfARGB4us1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGBA4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV; {$ELSE} fOpenGLFormat := tfRGBA4us1; {$ENDIF} end; procedure TfdRGB5A1us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfRGB5A1us1; fWithAlpha := tfRGB5A1us1; fWithoutAlpha := tfRGB5X1us1; fOpenGLFormat := tfRGB5A1us1; fRGBInverted := tfBGR5A1us1; fPrecision := glBitmapRec4ub( 5, 5, 5, 1); fShift := glBitmapRec4ub(11, 6, 1, 0); fglFormat := GL_RGBA; fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND}; fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1; end; procedure TfdA1RGB5us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfA1RGB5us1; fWithAlpha := tfA1RGB5us1; fWithoutAlpha := tfX1RGB5us1; fRGBInverted := tfA1BGR5us1; fPrecision := glBitmapRec4ub( 5, 5, 5, 1); fShift := glBitmapRec4ub(10, 5, 0, 15); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfA1RGB5us1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB5_A1; fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV; {$ELSE} fOpenGLFormat := tfRGB5A1us1; {$ENDIF} end; procedure TfdRGBA8ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfRGBA8ui1; fWithAlpha := tfRGBA8ui1; fWithoutAlpha := tfRGBX8ui1; fRGBInverted := tfBGRA8ui1; fPrecision := glBitmapRec4ub( 8, 8, 8, 8); fShift := glBitmapRec4ub(24, 16, 8, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfRGBA8ui1; fglFormat := GL_RGBA; fglInternalFormat := GL_RGBA8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8; {$ELSE} fOpenGLFormat := tfRGBA8ub4; {$ENDIF} end; procedure TfdARGB8ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfARGB8ui1; fWithAlpha := tfARGB8ui1; fWithoutAlpha := tfXRGB8ui1; fRGBInverted := tfABGR8ui1; fPrecision := glBitmapRec4ub( 8, 8, 8, 8); fShift := glBitmapRec4ub(16, 8, 0, 24); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfARGB8ui1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGBA8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV; {$ELSE} fOpenGLFormat := tfRGBA8ub4; {$ENDIF} end; procedure TfdRGBA8ub4.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfRGBA8ub4; fWithAlpha := tfRGBA8ub4; fWithoutAlpha := tfRGB8ub3; fOpenGLFormat := tfRGBA8ub4; fRGBInverted := tfBGRA8ub4; fPrecision := glBitmapRec4ub( 8, 8, 8, 8); fShift := glBitmapRec4ub( 0, 8, 16, 24); fglFormat := GL_RGBA; fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND}; fglDataFormat := GL_UNSIGNED_BYTE; end; procedure TfdRGB10A2ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfRGB10A2ui1; fWithAlpha := tfRGB10A2ui1; fWithoutAlpha := tfRGB10X2ui1; fRGBInverted := tfBGR10A2ui1; fPrecision := glBitmapRec4ub(10, 10, 10, 2); fShift := glBitmapRec4ub(22, 12, 2, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfRGB10A2ui1; fglFormat := GL_RGBA; fglInternalFormat := GL_RGB10_A2; fglDataFormat := GL_UNSIGNED_INT_10_10_10_2; {$ELSE} fOpenGLFormat := tfA2RGB10ui1; {$ENDIF} end; procedure TfdA2RGB10ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfA2RGB10ui1; fWithAlpha := tfA2RGB10ui1; fWithoutAlpha := tfX2RGB10ui1; fRGBInverted := tfA2BGR10ui1; fPrecision := glBitmapRec4ub(10, 10, 10, 2); fShift := glBitmapRec4ub(20, 10, 0, 30); {$IF NOT DEFINED(OPENGL_ES)} fOpenGLFormat := tfA2RGB10ui1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB10_A2; fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV; {$ELSEIF DEFINED(OPENGL_ES_3_0)} fOpenGLFormat := tfA2RGB10ui1; fglFormat := GL_RGBA; fglInternalFormat := GL_RGB10_A2; fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV; {$ELSE} fOpenGLFormat := tfRGBA8ui1; {$IFEND} end; procedure TfdRGBA16us4.SetValues; begin inherited SetValues; fBitsPerPixel := 64; fFormat := tfRGBA16us4; fWithAlpha := tfRGBA16us4; fWithoutAlpha := tfRGB16us3; fRGBInverted := tfBGRA16us4; fPrecision := glBitmapRec4ub(16, 16, 16, 16); fShift := glBitmapRec4ub( 0, 16, 32, 48); {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} fOpenGLFormat := tfRGBA16us4; fglFormat := GL_RGBA; fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF}; fglDataFormat := GL_UNSIGNED_SHORT; {$ELSE} fOpenGLFormat := tfRGBA8ub4; {$IFEND} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdBGRX4us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfBGRX4us1; fWithAlpha := tfBGRA4us1; fWithoutAlpha := tfBGRX4us1; fRGBInverted := tfRGBX4us1; fPrecision := glBitmapRec4ub( 4, 4, 4, 0); fShift := glBitmapRec4ub( 4, 8, 12, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGRX4us1; fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdXBGR4us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfXBGR4us1; fWithAlpha := tfABGR4us1; fWithoutAlpha := tfXBGR4us1; fRGBInverted := tfXRGB4us1; fPrecision := glBitmapRec4ub( 4, 4, 4, 0); fShift := glBitmapRec4ub( 0, 4, 8, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfXBGR4us1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdB5G6R5us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfB5G6R5us1; fWithAlpha := tfBGR5A1us1; fWithoutAlpha := tfB5G6R5us1; fRGBInverted := tfR5G6B5us1; fPrecision := glBitmapRec4ub( 5, 6, 5, 0); fShift := glBitmapRec4ub( 0, 5, 11, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfB5G6R5us1; fglFormat := GL_RGB; fglInternalFormat := GL_RGB565; fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdBGR5X1us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfBGR5X1us1; fWithAlpha := tfBGR5A1us1; fWithoutAlpha := tfBGR5X1us1; fRGBInverted := tfRGB5X1us1; fPrecision := glBitmapRec4ub( 5, 5, 5, 0); fShift := glBitmapRec4ub( 1, 6, 11, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGR5X1us1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB5; fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdX1BGR5us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfX1BGR5us1; fWithAlpha := tfA1BGR5us1; fWithoutAlpha := tfX1BGR5us1; fRGBInverted := tfX1RGB5us1; fPrecision := glBitmapRec4ub( 5, 5, 5, 0); fShift := glBitmapRec4ub( 0, 5, 10, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfX1BGR5us1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB5; fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV; {$ELSE} fOpenGLFormat := tfR5G6B5us1; {$ENDIF} end; procedure TfdBGR8ub3.SetValues; begin inherited SetValues; fBitsPerPixel := 24; fFormat := tfBGR8ub3; fWithAlpha := tfBGRA8ub4; fWithoutAlpha := tfBGR8ub3; fRGBInverted := tfRGB8ub3; fPrecision := glBitmapRec4ub( 8, 8, 8, 0); fShift := glBitmapRec4ub(16, 8, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGR8ub3; fglFormat := GL_BGR; fglInternalFormat := GL_RGB8; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := tfRGB8ub3; {$ENDIF} end; procedure TfdBGRX8ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfBGRX8ui1; fWithAlpha := tfBGRA8ui1; fWithoutAlpha := tfBGRX8ui1; fRGBInverted := tfRGBX8ui1; fPrecision := glBitmapRec4ub( 8, 8, 8, 0); fShift := glBitmapRec4ub( 8, 16, 24, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGRX8ui1; fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8; {$ELSE} fOpenGLFormat := tfRGB8ub3; {$ENDIF} end; procedure TfdXBGR8ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfXBGR8ui1; fWithAlpha := tfABGR8ui1; fWithoutAlpha := tfXBGR8ui1; fRGBInverted := tfXRGB8ui1; fPrecision := glBitmapRec4ub( 8, 8, 8, 0); fShift := glBitmapRec4ub( 0, 8, 16, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfXBGR8ui1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV; {$ELSE} fOpenGLFormat := tfRGB8ub3; {$ENDIF} end; procedure TfdBGR10X2ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfBGR10X2ui1; fWithAlpha := tfBGR10A2ui1; fWithoutAlpha := tfBGR10X2ui1; fRGBInverted := tfRGB10X2ui1; fPrecision := glBitmapRec4ub(10, 10, 10, 0); fShift := glBitmapRec4ub( 2, 12, 22, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGR10X2ui1; fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB10; fglDataFormat := GL_UNSIGNED_INT_10_10_10_2; {$ELSE} fOpenGLFormat := tfRGB16us3; {$ENDIF} end; procedure TfdX2BGR10ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfX2BGR10ui1; fWithAlpha := tfA2BGR10ui1; fWithoutAlpha := tfX2BGR10ui1; fRGBInverted := tfX2RGB10ui1; fPrecision := glBitmapRec4ub(10, 10, 10, 0); fShift := glBitmapRec4ub( 0, 10, 20, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfX2BGR10ui1; fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA fglInternalFormat := GL_RGB10; fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV; {$ELSE} fOpenGLFormat := tfRGB16us3; {$ENDIF} end; procedure TfdBGR16us3.SetValues; begin inherited SetValues; fBitsPerPixel := 48; fFormat := tfBGR16us3; fWithAlpha := tfBGRA16us4; fWithoutAlpha := tfBGR16us3; fRGBInverted := tfRGB16us3; fPrecision := glBitmapRec4ub(16, 16, 16, 0); fShift := glBitmapRec4ub(32, 16, 0, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGR16us3; fglFormat := GL_BGR; fglInternalFormat := GL_RGB16; fglDataFormat := GL_UNSIGNED_SHORT; {$ELSE} fOpenGLFormat := tfRGB16us3; {$ENDIF} end; procedure TfdBGRA4us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfBGRA4us1; fWithAlpha := tfBGRA4us1; fWithoutAlpha := tfBGRX4us1; fRGBInverted := tfRGBA4us1; fPrecision := glBitmapRec4ub( 4, 4, 4, 4); fShift := glBitmapRec4ub( 4, 8, 12, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGRA4us1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGBA4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4; {$ELSE} fOpenGLFormat := tfRGBA4us1; {$ENDIF} end; procedure TfdABGR4us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfABGR4us1; fWithAlpha := tfABGR4us1; fWithoutAlpha := tfXBGR4us1; fRGBInverted := tfARGB4us1; fPrecision := glBitmapRec4ub( 4, 4, 4, 4); fShift := glBitmapRec4ub( 0, 4, 8, 12); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfABGR4us1; fglFormat := GL_RGBA; fglInternalFormat := GL_RGBA4; fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV; {$ELSE} fOpenGLFormat := tfRGBA4us1; {$ENDIF} end; procedure TfdBGR5A1us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfBGR5A1us1; fWithAlpha := tfBGR5A1us1; fWithoutAlpha := tfBGR5X1us1; fRGBInverted := tfRGB5A1us1; fPrecision := glBitmapRec4ub( 5, 5, 5, 1); fShift := glBitmapRec4ub( 1, 6, 11, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGR5A1us1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB5_A1; fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1; {$ELSE} fOpenGLFormat := tfRGB5A1us1; {$ENDIF} end; procedure TfdA1BGR5us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfA1BGR5us1; fWithAlpha := tfA1BGR5us1; fWithoutAlpha := tfX1BGR5us1; fRGBInverted := tfA1RGB5us1; fPrecision := glBitmapRec4ub( 5, 5, 5, 1); fShift := glBitmapRec4ub( 0, 5, 10, 15); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfA1BGR5us1; fglFormat := GL_RGBA; fglInternalFormat := GL_RGB5_A1; fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV; {$ELSE} fOpenGLFormat := tfRGB5A1us1; {$ENDIF} end; procedure TfdBGRA8ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfBGRA8ui1; fWithAlpha := tfBGRA8ui1; fWithoutAlpha := tfBGRX8ui1; fRGBInverted := tfRGBA8ui1; fPrecision := glBitmapRec4ub( 8, 8, 8, 8); fShift := glBitmapRec4ub( 8, 16, 24, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGRA8ui1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGBA8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8; {$ELSE} fOpenGLFormat := tfRGBA8ub4; {$ENDIF} end; procedure TfdABGR8ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfABGR8ui1; fWithAlpha := tfABGR8ui1; fWithoutAlpha := tfXBGR8ui1; fRGBInverted := tfARGB8ui1; fPrecision := glBitmapRec4ub( 8, 8, 8, 8); fShift := glBitmapRec4ub( 0, 8, 16, 24); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfABGR8ui1; fglFormat := GL_RGBA; fglInternalFormat := GL_RGBA8; fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV; {$ELSE} fOpenGLFormat := tfRGBA8ub4 {$ENDIF} end; procedure TfdBGRA8ub4.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfBGRA8ub4; fWithAlpha := tfBGRA8ub4; fWithoutAlpha := tfBGR8ub3; fRGBInverted := tfRGBA8ub4; fPrecision := glBitmapRec4ub( 8, 8, 8, 8); fShift := glBitmapRec4ub(16, 8, 0, 24); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGRA8ub4; fglFormat := GL_BGRA; fglInternalFormat := GL_RGBA8; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := tfRGBA8ub4; {$ENDIF} end; procedure TfdBGR10A2ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfBGR10A2ui1; fWithAlpha := tfBGR10A2ui1; fWithoutAlpha := tfBGR10X2ui1; fRGBInverted := tfRGB10A2ui1; fPrecision := glBitmapRec4ub(10, 10, 10, 2); fShift := glBitmapRec4ub( 2, 12, 22, 0); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGR10A2ui1; fglFormat := GL_BGRA; fglInternalFormat := GL_RGB10_A2; fglDataFormat := GL_UNSIGNED_INT_10_10_10_2; {$ELSE} fOpenGLFormat := tfA2RGB10ui1; {$ENDIF} end; procedure TfdA2BGR10ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfA2BGR10ui1; fWithAlpha := tfA2BGR10ui1; fWithoutAlpha := tfX2BGR10ui1; fRGBInverted := tfA2RGB10ui1; fPrecision := glBitmapRec4ub(10, 10, 10, 2); fShift := glBitmapRec4ub( 0, 10, 20, 30); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfA2BGR10ui1; fglFormat := GL_RGBA; fglInternalFormat := GL_RGB10_A2; fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV; {$ELSE} fOpenGLFormat := tfA2RGB10ui1; {$ENDIF} end; procedure TfdBGRA16us4.SetValues; begin inherited SetValues; fBitsPerPixel := 64; fFormat := tfBGRA16us4; fWithAlpha := tfBGRA16us4; fWithoutAlpha := tfBGR16us3; fRGBInverted := tfRGBA16us4; fPrecision := glBitmapRec4ub(16, 16, 16, 16); fShift := glBitmapRec4ub(32, 16, 0, 48); {$IFNDEF OPENGL_ES} fOpenGLFormat := tfBGRA16us4; fglFormat := GL_BGRA; fglInternalFormat := GL_RGBA16; fglDataFormat := GL_UNSIGNED_SHORT; {$ELSE} fOpenGLFormat := tfRGBA16us4; {$ENDIF} end; procedure TfdDepth16us1.SetValues; begin inherited SetValues; fBitsPerPixel := 16; fFormat := tfDepth16us1; fWithoutAlpha := tfDepth16us1; fPrecision := glBitmapRec4ub(16, 16, 16, 16); fShift := glBitmapRec4ub( 0, 0, 0, 0); {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)} fOpenGLFormat := tfDepth16us1; fglFormat := GL_DEPTH_COMPONENT; fglInternalFormat := GL_DEPTH_COMPONENT16; fglDataFormat := GL_UNSIGNED_SHORT; {$IFEND} end; procedure TfdDepth24ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfDepth24ui1; fWithoutAlpha := tfDepth24ui1; fOpenGLFormat := tfDepth24ui1; fPrecision := glBitmapRec4ub(32, 32, 32, 32); fShift := glBitmapRec4ub( 0, 0, 0, 0); {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} fOpenGLFormat := tfDepth24ui1; fglFormat := GL_DEPTH_COMPONENT; fglInternalFormat := GL_DEPTH_COMPONENT24; fglDataFormat := GL_UNSIGNED_INT; {$IFEND} end; procedure TfdDepth32ui1.SetValues; begin inherited SetValues; fBitsPerPixel := 32; fFormat := tfDepth32ui1; fWithoutAlpha := tfDepth32ui1; fPrecision := glBitmapRec4ub(32, 32, 32, 32); fShift := glBitmapRec4ub( 0, 0, 0, 0); {$IF NOT DEFINED(OPENGL_ES)} fOpenGLFormat := tfDepth32ui1; fglFormat := GL_DEPTH_COMPONENT; fglInternalFormat := GL_DEPTH_COMPONENT32; fglDataFormat := GL_UNSIGNED_INT; {$ELSEIF DEFINED(OPENGL_ES_3_0)} fOpenGLFormat := tfDepth24ui1; {$ELSEIF DEFINED(OPENGL_ES_2_0)} fOpenGLFormat := tfDepth16us1; {$IFEND} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdS3tcDtx1RGBA///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin raise EglBitmap.Create('mapping for compressed formats is not supported'); end; procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin raise EglBitmap.Create('mapping for compressed formats is not supported'); end; procedure TfdS3tcDtx1RGBA.SetValues; begin inherited SetValues; fFormat := tfS3tcDtx1RGBA; fWithAlpha := tfS3tcDtx1RGBA; fUncompressed := tfRGB5A1us1; fBitsPerPixel := 4; fIsCompressed := true; {$IFNDEF OPENGL_ES} fOpenGLFormat := tfS3tcDtx1RGBA; fglFormat := GL_COMPRESSED_RGBA; fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := fUncompressed; {$ENDIF} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdS3tcDtx3RGBA///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin raise EglBitmap.Create('mapping for compressed formats is not supported'); end; procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin raise EglBitmap.Create('mapping for compressed formats is not supported'); end; procedure TfdS3tcDtx3RGBA.SetValues; begin inherited SetValues; fFormat := tfS3tcDtx3RGBA; fWithAlpha := tfS3tcDtx3RGBA; fUncompressed := tfRGBA8ub4; fBitsPerPixel := 8; fIsCompressed := true; {$IFNDEF OPENGL_ES} fOpenGLFormat := tfS3tcDtx3RGBA; fglFormat := GL_COMPRESSED_RGBA; fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := fUncompressed; {$ENDIF} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TfdS3tcDtx5RGBA///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin raise EglBitmap.Create('mapping for compressed formats is not supported'); end; procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin raise EglBitmap.Create('mapping for compressed formats is not supported'); end; procedure TfdS3tcDtx5RGBA.SetValues; begin inherited SetValues; fFormat := tfS3tcDtx3RGBA; fWithAlpha := tfS3tcDtx3RGBA; fUncompressed := tfRGBA8ub4; fBitsPerPixel := 8; fIsCompressed := true; {$IFNDEF OPENGL_ES} fOpenGLFormat := tfS3tcDtx3RGBA; fglFormat := GL_COMPRESSED_RGBA; fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT; fglDataFormat := GL_UNSIGNED_BYTE; {$ELSE} fOpenGLFormat := fUncompressed; {$ENDIF} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmapFormatDescriptor/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmapFormatDescriptor.GetHasRed: Boolean; begin result := (fPrecision.r > 0); end; function TglBitmapFormatDescriptor.GetHasGreen: Boolean; begin result := (fPrecision.g > 0); end; function TglBitmapFormatDescriptor.GetHasBlue: Boolean; begin result := (fPrecision.b > 0); end; function TglBitmapFormatDescriptor.GetHasAlpha: Boolean; begin result := (fPrecision.a > 0); end; function TglBitmapFormatDescriptor.GetHasColor: Boolean; begin result := HasRed or HasGreen or HasBlue; end; function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean; begin result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapFormatDescriptor.SetValues; begin fFormat := tfEmpty; fWithAlpha := tfEmpty; fWithoutAlpha := tfEmpty; fOpenGLFormat := tfEmpty; fRGBInverted := tfEmpty; fUncompressed := tfEmpty; fBitsPerPixel := 0; fIsCompressed := false; fglFormat := 0; fglInternalFormat := 0; fglDataFormat := 0; FillChar(fPrecision, 0, SizeOf(fPrecision)); FillChar(fShift, 0, SizeOf(fShift)); end; procedure TglBitmapFormatDescriptor.CalcValues; var i: Integer; begin fBytesPerPixel := fBitsPerPixel / 8; fChannelCount := 0; for i := 0 to 3 do begin if (fPrecision.arr[i] > 0) then inc(fChannelCount); fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1; fMask.arr[i] := fRange.arr[i] shl fShift.arr[i]; end; end; constructor TglBitmapFormatDescriptor.Create; begin inherited Create; SetValues; CalcValues; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor; var f: TglBitmapFormat; begin for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin result := TFormatDescriptor.Get(f); if (result.glInternalFormat = aInternalFormat) then exit; end; result := TFormatDescriptor.Get(tfEmpty); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TFormatDescriptor/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class procedure TFormatDescriptor.Init; begin if not Assigned(FormatDescriptorCS) then FormatDescriptorCS := TCriticalSection.Create; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor; begin FormatDescriptorCS.Enter; try result := FormatDescriptors[aFormat]; if not Assigned(result) then begin result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create; FormatDescriptors[aFormat] := result; end; finally FormatDescriptorCS.Leave; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor; begin result := Get(Get(aFormat).WithAlpha); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor; var ft: TglBitmapFormat; begin // find matching format with OpenGL support for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin result := Get(ft); if (result.MaskMatch(aMask)) and (result.glFormat <> 0) and (result.glInternalFormat <> 0) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then exit; end; // find matching format without OpenGL Support for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin result := Get(ft); if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then exit; end; result := TFormatDescriptor.Get(tfEmpty); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor; var ft: TglBitmapFormat; begin // find matching format with OpenGL support for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin result := Get(ft); if glBitmapRec4ubCompare(result.Shift, aShift) and glBitmapRec4ubCompare(result.Precision, aPrec) and (result.glFormat <> 0) and (result.glInternalFormat <> 0) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then exit; end; // find matching format without OpenGL Support for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin result := Get(ft); if glBitmapRec4ubCompare(result.Shift, aShift) and glBitmapRec4ubCompare(result.Precision, aPrec) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then exit; end; result := TFormatDescriptor.Get(tfEmpty); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class procedure TFormatDescriptor.Clear; var f: TglBitmapFormat; begin FormatDescriptorCS.Enter; try for f := low(FormatDescriptors) to high(FormatDescriptors) do FreeAndNil(FormatDescriptors[f]); finally FormatDescriptorCS.Leave; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class procedure TFormatDescriptor.Finalize; begin Clear; FreeAndNil(FormatDescriptorCS); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TBitfieldFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); var i: Integer; begin for i := 0 to 3 do begin fShift.arr[i] := 0; while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin aMask.arr[i] := aMask.arr[i] shr 1; inc(fShift.arr[i]); end; fPrecision.arr[i] := CountSetBits(aMask.arr[i]); end; CalcValues; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); begin fBitsPerPixel := aBBP; fPrecision := aPrec; fShift := aShift; CalcValues; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); var data: QWord; begin data := ((aPixel.Data.r and Range.r) shl Shift.r) or ((aPixel.Data.g and Range.g) shl Shift.g) or ((aPixel.Data.b and Range.b) shl Shift.b) or ((aPixel.Data.a and Range.a) shl Shift.a); case BitsPerPixel of 8: aData^ := data; 16: PWord(aData)^ := data; 32: PCardinal(aData)^ := data; 64: PQWord(aData)^ := data; else raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]); end; inc(aData, Round(BytesPerPixel)); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); var data: QWord; i: Integer; begin case BitsPerPixel of 8: data := aData^; 16: data := PWord(aData)^; 32: data := PCardinal(aData)^; 64: data := PQWord(aData)^; else raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]); end; for i := 0 to 3 do aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i]; inc(aData, Round(BytesPerPixel)); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TColorTableFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpColorTableFormat.SetValues; begin inherited SetValues; fShift := glBitmapRec4ub(8, 8, 8, 0); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); begin fFormat := aFormat; fBitsPerPixel := aBPP; fPrecision := aPrec; fShift := aShift; CalcValues; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpColorTableFormat.CalcValues; begin inherited CalcValues; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpColorTableFormat.CreateColorTable; var i: Integer; begin SetLength(fColorTable, 256); if not HasColor then begin // alpha for i := 0 to High(fColorTable) do begin fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255); fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255); fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255); fColorTable[i].a := 0; end; end else begin // normal for i := 0 to High(fColorTable) do begin fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255); fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255); fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255); fColorTable[i].a := 0; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); begin if (BitsPerPixel <> 8) then raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats'); if not HasColor then // alpha aData^ := aPixel.Data.a else // normal aData^ := Round( ((aPixel.Data.r and Range.r) shl Shift.r) or ((aPixel.Data.g and Range.g) shl Shift.g) or ((aPixel.Data.b and Range.b) shl Shift.b)); inc(aData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); begin if (BitsPerPixel <> 8) then raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats'); with fColorTable[aData^] do begin aPixel.Data.r := r; aPixel.Data.g := g; aPixel.Data.b := b; aPixel.Data.a := a; end; inc(aData, 1); end; destructor TbmpColorTableFormat.Destroy; begin SetLength(fColorTable, 0); inherited Destroy; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmap - Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor); var i: Integer; begin for i := 0 to 3 do begin if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin if (aSourceFD.Range.arr[i] > 0) then aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i]) else aPixel.Data.arr[i] := 0; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec); begin with aFuncRec do begin if (Source.Range.r > 0) then Dest.Data.r := Source.Data.r; if (Source.Range.g > 0) then Dest.Data.g := Source.Data.g; if (Source.Range.b > 0) then Dest.Data.b := Source.Data.b; if (Source.Range.a > 0) then Dest.Data.a := Source.Data.a; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec); var i: Integer; begin with aFuncRec do begin for i := 0 to 3 do if (Source.Range.arr[i] > 0) then Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]); end; end; type TShiftData = packed record case Integer of 0: (r, g, b, a: SmallInt); 1: (arr: array[0..3] of SmallInt); end; PShiftData = ^TShiftData; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec); var i: Integer; begin with aFuncRec do for i := 0 to 3 do if (Source.Range.arr[i] > 0) then Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i]; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec); begin with aFuncRec do begin Dest.Data := Source.Data; if ({%H-}PtrUInt(Args) and $1 > 0) then begin Dest.Data.r := Dest.Data.r xor Dest.Range.r; Dest.Data.g := Dest.Data.g xor Dest.Range.g; Dest.Data.b := Dest.Data.b xor Dest.Range.b; end; if ({%H-}PtrUInt(Args) and $2 > 0) then begin Dest.Data.a := Dest.Data.a xor Dest.Range.a; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec); var i: Integer; begin with aFuncRec do begin for i := 0 to 3 do Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i]; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec); var Temp: Single; begin with FuncRec do begin if (FuncRec.Args = nil) then begin //source has no alpha Temp := Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R + Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G + Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B; Dest.Data.a := Round(Dest.Range.a * Temp); end else Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec); type PglBitmapPixelData = ^TglBitmapPixelData; begin with FuncRec do begin Dest.Data.r := Source.Data.r; Dest.Data.g := Source.Data.g; Dest.Data.b := Source.Data.b; with PglBitmapPixelData(Args)^ do if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then Dest.Data.a := 0 else Dest.Data.a := Dest.Range.a; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec); begin with FuncRec do begin Dest.Data.r := Source.Data.r; Dest.Data.g := Source.Data.g; Dest.Data.b := Source.Data.b; Dest.Data.a := PCardinal(Args)^; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean); type PRGBPix = ^TRGBPix; TRGBPix = array [0..2] of byte; var Temp: Byte; begin while aWidth > 0 do begin Temp := PRGBPix(aData)^[0]; PRGBPix(aData)^[0] := PRGBPix(aData)^[2]; PRGBPix(aData)^[2] := Temp; if aHasAlpha then Inc(aData, 4) else Inc(aData, 3); dec(aWidth); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmap - PROTECTED/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor; begin result := TFormatDescriptor.Get(Format); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.GetWidth: Integer; begin if (ffX in fDimension.Fields) then result := fDimension.X else result := -1; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.GetHeight: Integer; begin if (ffY in fDimension.Fields) then result := fDimension.Y else result := -1; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.GetFileWidth: Integer; begin result := Max(1, Width); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.GetFileHeight: Integer; begin result := Max(1, Height); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetCustomData(const aValue: Pointer); begin if fCustomData = aValue then exit; fCustomData := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetCustomName(const aValue: String); begin if fCustomName = aValue then exit; fCustomName := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetCustomNameW(const aValue: WideString); begin if fCustomNameW = aValue then exit; fCustomNameW := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean); begin if fFreeDataOnDestroy = aValue then exit; fFreeDataOnDestroy := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean); begin if fDeleteTextureOnFree = aValue then exit; fDeleteTextureOnFree := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat); begin if fFormat = aValue then exit; if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then raise EglBitmapUnsupportedFormat.Create(Format); SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean); begin if fFreeDataAfterGenTexture = aValue then exit; fFreeDataAfterGenTexture := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetID(const aValue: Cardinal); begin if fID = aValue then exit; fID := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap); begin if fMipMap = aValue then exit; fMipMap := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetTarget(const aValue: Cardinal); begin if fTarget = aValue then exit; fTarget := aValue; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetAnisotropic(const aValue: Integer); {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)} var MaxAnisotropic: Integer; {$IFEND} begin fAnisotropic := aValue; if (ID > 0) then begin {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)} if GL_EXT_texture_filter_anisotropic then begin if fAnisotropic > 0 then begin Bind(false); glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic); if aValue > MaxAnisotropic then fAnisotropic := MaxAnisotropic; glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic); end; end else begin fAnisotropic := 0; end; {$ELSE} fAnisotropic := 0; {$IFEND} end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.CreateID; begin if (ID <> 0) then glDeleteTextures(1, @fID); glGenTextures(1, @fID); Bind(false); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF}); begin // Set Up Parameters SetWrap(fWrapS, fWrapT, fWrapR); SetFilter(fFilterMin, fFilterMag); SetAnisotropic(fAnisotropic); {$IFNDEF OPENGL_ES} SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]); if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]); {$ENDIF} {$IFNDEF OPENGL_ES} // Mip Maps Generation Mode aBuildWithGlu := false; if (MipMap = mmMipmap) then begin if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE) else aBuildWithGlu := true; end else if (MipMap = mmMipmapGlu) then aBuildWithGlu := true; {$ELSE} if (MipMap = mmMipmap) then glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE); {$ENDIF} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer); var s: Single; begin if (Data <> aData) then begin if (Assigned(Data)) then FreeMem(Data); fData := aData; end; if not Assigned(fData) then begin fPixelSize := 0; fRowSize := 0; end else begin FillChar(fDimension, SizeOf(fDimension), 0); if aWidth <> -1 then begin fDimension.Fields := fDimension.Fields + [ffX]; fDimension.X := aWidth; end; if aHeight <> -1 then begin fDimension.Fields := fDimension.Fields + [ffY]; fDimension.Y := aHeight; end; s := TFormatDescriptor.Get(aFormat).BytesPerPixel; fFormat := aFormat; fPixelSize := Ceil(s); fRowSize := Ceil(s * aWidth); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.FlipHorz: Boolean; begin result := false; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.FlipVert: Boolean; begin result := false; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmap - PUBLIC////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.AfterConstruction; begin inherited AfterConstruction; fID := 0; fTarget := 0; {$IFNDEF OPENGL_ES} fIsResident := false; {$ENDIF} fMipMap := glBitmapDefaultMipmap; fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture; fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree; glBitmapGetDefaultFilter (fFilterMin, fFilterMag); glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR); {$IFNDEF OPENGL_ES} glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]); {$ENDIF} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.BeforeDestruction; var NewData: PByte; begin if fFreeDataOnDestroy then begin NewData := nil; SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method end; if (fID > 0) and fDeleteTextureOnFree then glDeleteTextures(1, @fID); inherited BeforeDestruction; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar); var TempPos: Integer; begin if not Assigned(aResType) then begin TempPos := Pos('.', aResource); aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos))); aResource := UpperCase(Copy(aResource, 0, TempPos -1)); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.LoadFromFile(const aFilename: String); var fs: TFileStream; begin if not FileExists(aFilename) then raise EglBitmap.Create('file does not exist: ' + aFilename); fFilename := aFilename; fs := TFileStream.Create(fFilename, fmOpenRead); try fs.Position := 0; LoadFromStream(fs); finally fs.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.LoadFromStream(const aStream: TStream); begin {$IFDEF GLB_SUPPORT_PNG_READ} if not LoadPNG(aStream) then {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_READ} if not LoadJPEG(aStream) then {$ENDIF} if not LoadDDS(aStream) then if not LoadTGA(aStream) then if not LoadBMP(aStream) then if not LoadRAW(aStream) then raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.'); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapSize; const aFunc: TglBitmapFunction; const aFormat: TglBitmapFormat; const aArgs: Pointer); var tmpData: PByte; size: Integer; begin size := TFormatDescriptor.Get(aFormat).GetSize(aSize); GetMem(tmpData, size); try FillChar(tmpData^, size, #$FF); SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method except if Assigned(tmpData) then FreeMem(tmpData); raise; end; Convert(Self, aFunc, false, aFormat, aArgs); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar); var rs: TResourceStream; begin PrepareResType(aResource, aResType); rs := TResourceStream.Create(aInstance, aResource, aResType); try LoadFromStream(rs); finally rs.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); var rs: TResourceStream; begin rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType); try LoadFromStream(rs); finally rs.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType); var fs: TFileStream; begin fs := TFileStream.Create(aFileName, fmCreate); try fs.Position := 0; SaveToStream(fs, aFileType); finally fs.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); begin case aFileType of {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG: SavePNG(aStream); {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_WRITE} ftJPEG: SaveJPEG(aStream); {$ENDIF} ftDDS: SaveDDS(aStream); ftTGA: SaveTGA(aStream); ftBMP: SaveBMP(aStream); ftRAW: SaveRAW(aStream); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean; begin result := Convert(Self, aFunc, aCreateTemp, Format, aArgs); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.Convert(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean; const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean; var DestData, TmpData, SourceData: pByte; TempHeight, TempWidth: Integer; SourceFD, DestFD: TFormatDescriptor; SourceMD, DestMD: Pointer; FuncRec: TglBitmapFunctionRec; begin Assert(Assigned(Data)); Assert(Assigned(aSource)); Assert(Assigned(aSource.Data)); result := false; if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin SourceFD := TFormatDescriptor.Get(aSource.Format); DestFD := TFormatDescriptor.Get(aFormat); if (SourceFD.IsCompressed) then raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format); if (DestFD.IsCompressed) then raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format); // inkompatible Formats so CreateTemp if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then aCreateTemp := true; // Values TempHeight := Max(1, aSource.Height); TempWidth := Max(1, aSource.Width); FuncRec.Sender := Self; FuncRec.Args := aArgs; TmpData := nil; if aCreateTemp then begin GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight)); DestData := TmpData; end else DestData := Data; try SourceFD.PreparePixel(FuncRec.Source); DestFD.PreparePixel (FuncRec.Dest); SourceMD := SourceFD.CreateMappingData; DestMD := DestFD.CreateMappingData; FuncRec.Size := aSource.Dimension; FuncRec.Position.Fields := FuncRec.Size.Fields; try SourceData := aSource.Data; FuncRec.Position.Y := 0; while FuncRec.Position.Y < TempHeight do begin FuncRec.Position.X := 0; while FuncRec.Position.X < TempWidth do begin SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD); aFunc(FuncRec); DestFD.Map(FuncRec.Dest, DestData, DestMD); inc(FuncRec.Position.X); end; inc(FuncRec.Position.Y); end; // Updating Image or InternalFormat if aCreateTemp then SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method else if (aFormat <> fFormat) then Format := aFormat; result := true; finally SourceFD.FreeMappingData(SourceMD); DestFD.FreeMappingData(DestMD); end; except if aCreateTemp and Assigned(TmpData) then FreeMem(TmpData); raise; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean; var SourceFD, DestFD: TFormatDescriptor; SourcePD, DestPD: TglBitmapPixelData; ShiftData: TShiftData; function DataIsIdentical: Boolean; begin result := SourceFD.MaskMatch(DestFD.Mask); end; function CanCopyDirect: Boolean; begin result := ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0)); end; function CanShift: Boolean; begin result := ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0)); end; function GetShift(aSource, aDest: Cardinal) : ShortInt; begin result := 0; while (aSource > aDest) and (aSource > 0) do begin inc(result); aSource := aSource shr 1; end; end; begin if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin SourceFD := TFormatDescriptor.Get(Format); DestFD := TFormatDescriptor.Get(aFormat); if DataIsIdentical then begin result := true; Format := aFormat; exit; end; SourceFD.PreparePixel(SourcePD); DestFD.PreparePixel (DestPD); if CanCopyDirect then result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat) else if CanShift then begin ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r); ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g); ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b); ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a); result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData); end else result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat); end else result := true; end; {$IFDEF GLB_SDL} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean; var Row, RowSize: Integer; SourceData, TmpData: PByte; TempDepth: Integer; FormatDesc: TFormatDescriptor; function GetRowPointer(Row: Integer): pByte; begin result := aSurface.pixels; Inc(result, Row * RowSize); end; begin result := false; FormatDesc := TFormatDescriptor.Get(Format); if FormatDesc.IsCompressed then raise EglBitmapUnsupportedFormat.Create(Format); if Assigned(Data) then begin case Trunc(FormatDesc.PixelSize) of 1: TempDepth := 8; 2: TempDepth := 16; 3: TempDepth := 24; 4: TempDepth := 32; else raise EglBitmapUnsupportedFormat.Create(Format); end; aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth, FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask); SourceData := Data; RowSize := FormatDesc.GetSize(FileWidth, 1); for Row := 0 to FileHeight-1 do begin TmpData := GetRowPointer(Row); if Assigned(TmpData) then begin Move(SourceData^, TmpData^, RowSize); inc(SourceData, RowSize); end; end; result := true; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean; var pSource, pData, pTempData: PByte; Row, RowSize, TempWidth, TempHeight: Integer; IntFormat: TglBitmapFormat; fd: TFormatDescriptor; Mask: TglBitmapMask; function GetRowPointer(Row: Integer): pByte; begin result := aSurface^.pixels; Inc(result, Row * RowSize); end; begin result := false; if (Assigned(aSurface)) then begin with aSurface^.format^ do begin Mask.r := RMask; Mask.g := GMask; Mask.b := BMask; Mask.a := AMask; IntFormat := TFormatDescriptor.GetFromMask(Mask).Format; if (IntFormat = tfEmpty) then raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.'); end; fd := TFormatDescriptor.Get(IntFormat); TempWidth := aSurface^.w; TempHeight := aSurface^.h; RowSize := fd.GetSize(TempWidth, 1); GetMem(pData, TempHeight * RowSize); try pTempData := pData; for Row := 0 to TempHeight -1 do begin pSource := GetRowPointer(Row); if (Assigned(pSource)) then begin Move(pSource^, pTempData^, RowSize); Inc(pTempData, RowSize); end; end; SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method result := true; except if Assigned(pData) then FreeMem(pData); raise; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean; var Row, Col, AlphaInterleave: Integer; pSource, pDest: PByte; function GetRowPointer(Row: Integer): pByte; begin result := aSurface.pixels; Inc(result, Row * Width); end; begin result := false; if Assigned(Data) then begin if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0); AlphaInterleave := 0; case Format of tfLuminance8Alpha8ub2: AlphaInterleave := 1; tfBGRA8ub4, tfRGBA8ub4: AlphaInterleave := 3; end; pSource := Data; for Row := 0 to Height -1 do begin pDest := GetRowPointer(Row); if Assigned(pDest) then begin for Col := 0 to Width -1 do begin Inc(pSource, AlphaInterleave); pDest^ := pSource^; Inc(pDest); Inc(pSource); end; end; end; result := true; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean; var bmp: TglBitmap2D; begin bmp := TglBitmap2D.Create; try bmp.AssignFromSurface(aSurface); result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs); finally bmp.Free; end; end; {$ENDIF} {$IFDEF GLB_DELPHI} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function CreateGrayPalette: HPALETTE; var Idx: Integer; Pal: PLogPalette; begin GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256)); Pal.palVersion := $300; Pal.palNumEntries := 256; for Idx := 0 to Pal.palNumEntries - 1 do begin Pal.palPalEntry[Idx].peRed := Idx; Pal.palPalEntry[Idx].peGreen := Idx; Pal.palPalEntry[Idx].peBlue := Idx; Pal.palPalEntry[Idx].peFlags := 0; end; Result := CreatePalette(Pal^); FreeMem(Pal); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean; var Row: Integer; pSource, pData: PByte; begin result := false; if Assigned(Data) then begin if Assigned(aBitmap) then begin aBitmap.Width := Width; aBitmap.Height := Height; case Format of tfAlpha8ub1, tfLuminance8ub1: begin aBitmap.PixelFormat := pf8bit; aBitmap.Palette := CreateGrayPalette; end; tfRGB5A1us1: aBitmap.PixelFormat := pf15bit; tfR5G6B5us1: aBitmap.PixelFormat := pf16bit; tfRGB8ub3, tfBGR8ub3: aBitmap.PixelFormat := pf24bit; tfRGBA8ub4, tfBGRA8ub4: aBitmap.PixelFormat := pf32bit; else raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.'); end; pSource := Data; for Row := 0 to FileHeight -1 do begin pData := aBitmap.Scanline[Row]; Move(pSource^, pData^, fRowSize); Inc(pSource, fRowSize); if (Format in [tfRGB8ub3, tfRGBA8ub4]) then // swap RGB(A) to BGR(A) SwapRGB(pData, FileWidth, Format = tfRGBA8ub4); end; result := true; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean; var pSource, pData, pTempData: PByte; Row, RowSize, TempWidth, TempHeight: Integer; IntFormat: TglBitmapFormat; begin result := false; if (Assigned(aBitmap)) then begin case aBitmap.PixelFormat of pf8bit: IntFormat := tfLuminance8ub1; pf15bit: IntFormat := tfRGB5A1us1; pf16bit: IntFormat := tfR5G6B5us1; pf24bit: IntFormat := tfBGR8ub3; pf32bit: IntFormat := tfBGRA8ub4; else raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.'); end; TempWidth := aBitmap.Width; TempHeight := aBitmap.Height; RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1); GetMem(pData, TempHeight * RowSize); try pTempData := pData; for Row := 0 to TempHeight -1 do begin pSource := aBitmap.Scanline[Row]; if (Assigned(pSource)) then begin Move(pSource^, pTempData^, RowSize); Inc(pTempData, RowSize); end; end; SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method result := true; except if Assigned(pData) then FreeMem(pData); raise; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean; var Row, Col, AlphaInterleave: Integer; pSource, pDest: PByte; begin result := false; if Assigned(Data) then begin if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin if Assigned(aBitmap) then begin aBitmap.PixelFormat := pf8bit; aBitmap.Palette := CreateGrayPalette; aBitmap.Width := Width; aBitmap.Height := Height; case Format of tfLuminance8Alpha8ub2: AlphaInterleave := 1; tfRGBA8ub4, tfBGRA8ub4: AlphaInterleave := 3; else AlphaInterleave := 0; end; // Copy Data pSource := Data; for Row := 0 to Height -1 do begin pDest := aBitmap.Scanline[Row]; if Assigned(pDest) then begin for Col := 0 to Width -1 do begin Inc(pSource, AlphaInterleave); pDest^ := pSource^; Inc(pDest); Inc(pSource); end; end; end; result := true; end; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean; var tex: TglBitmap2D; begin tex := TglBitmap2D.Create; try tex.AssignFromBitmap(ABitmap); result := AddAlphaFromglBitmap(tex, aFunc, aArgs); finally tex.Free; end; end; {$ENDIF} {$IFDEF GLB_LAZARUS} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean; var rid: TRawImageDescription; FormatDesc: TFormatDescriptor; begin if not Assigned(Data) then raise EglBitmap.Create('no pixel data assigned. load data before save'); result := false; if not Assigned(aImage) or (Format = tfEmpty) then exit; FormatDesc := TFormatDescriptor.Get(Format); if FormatDesc.IsCompressed then exit; FillChar(rid{%H-}, SizeOf(rid), 0); if FormatDesc.IsGrayscale then rid.Format := ricfGray else rid.Format := ricfRGBA; rid.Width := Width; rid.Height := Height; rid.Depth := FormatDesc.BitsPerPixel; rid.BitOrder := riboBitsInOrder; rid.ByteOrder := riboLSBFirst; rid.LineOrder := riloTopToBottom; rid.LineEnd := rileTight; rid.BitsPerPixel := FormatDesc.BitsPerPixel; rid.RedPrec := CountSetBits(FormatDesc.Range.r); rid.GreenPrec := CountSetBits(FormatDesc.Range.g); rid.BluePrec := CountSetBits(FormatDesc.Range.b); rid.AlphaPrec := CountSetBits(FormatDesc.Range.a); rid.RedShift := FormatDesc.Shift.r; rid.GreenShift := FormatDesc.Shift.g; rid.BlueShift := FormatDesc.Shift.b; rid.AlphaShift := FormatDesc.Shift.a; rid.MaskBitsPerPixel := 0; rid.PaletteColorCount := 0; aImage.DataDescription := rid; aImage.CreateData; if not Assigned(aImage.PixelData) then raise EglBitmap.Create('error while creating LazIntfImage'); Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension)); result := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean; var f: TglBitmapFormat; FormatDesc: TFormatDescriptor; ImageData: PByte; ImageSize: Integer; CanCopy: Boolean; Mask: TglBitmapRec4ul; procedure CopyConvert; var bfFormat: TbmpBitfieldFormat; pSourceLine, pDestLine: PByte; pSourceMD, pDestMD: Pointer; Shift, Prec: TglBitmapRec4ub; x, y: Integer; pixel: TglBitmapPixelData; begin bfFormat := TbmpBitfieldFormat.Create; with aImage.DataDescription do begin Prec.r := RedPrec; Prec.g := GreenPrec; Prec.b := BluePrec; Prec.a := AlphaPrec; Shift.r := RedShift; Shift.g := GreenShift; Shift.b := BlueShift; Shift.a := AlphaShift; bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift); end; pSourceMD := bfFormat.CreateMappingData; pDestMD := FormatDesc.CreateMappingData; try for y := 0 to aImage.Height-1 do begin pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine; pDestLine := ImageData + y * Round(FormatDesc.BytesPerPixel * aImage.Width); for x := 0 to aImage.Width-1 do begin bfFormat.Unmap(pSourceLine, pixel, pSourceMD); FormatDesc.Map(pixel, pDestLine, pDestMD); end; end; finally FormatDesc.FreeMappingData(pDestMD); bfFormat.FreeMappingData(pSourceMD); bfFormat.Free; end; end; begin result := false; if not Assigned(aImage) then exit; with aImage.DataDescription do begin Mask.r := (QWord(1 shl RedPrec )-1) shl RedShift; Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift; Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift; Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift; end; FormatDesc := TFormatDescriptor.GetFromMask(Mask); f := FormatDesc.Format; if (f = tfEmpty) then exit; CanCopy := (FormatDesc.BitsPerPixel = aImage.DataDescription.Depth) and (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth); ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height); ImageData := GetMem(ImageSize); try if CanCopy then Move(aImage.PixelData^, ImageData^, ImageSize) else CopyConvert; SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method except if Assigned(ImageData) then FreeMem(ImageData); raise; end; result := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean; var rid: TRawImageDescription; FormatDesc: TFormatDescriptor; Pixel: TglBitmapPixelData; x, y: Integer; srcMD: Pointer; src, dst: PByte; begin result := false; if not Assigned(aImage) or (Format = tfEmpty) then exit; FormatDesc := TFormatDescriptor.Get(Format); if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then exit; FillChar(rid{%H-}, SizeOf(rid), 0); rid.Format := ricfGray; rid.Width := Width; rid.Height := Height; rid.Depth := CountSetBits(FormatDesc.Range.a); rid.BitOrder := riboBitsInOrder; rid.ByteOrder := riboLSBFirst; rid.LineOrder := riloTopToBottom; rid.LineEnd := rileTight; rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8); rid.RedPrec := CountSetBits(FormatDesc.Range.a); rid.GreenPrec := 0; rid.BluePrec := 0; rid.AlphaPrec := 0; rid.RedShift := 0; rid.GreenShift := 0; rid.BlueShift := 0; rid.AlphaShift := 0; rid.MaskBitsPerPixel := 0; rid.PaletteColorCount := 0; aImage.DataDescription := rid; aImage.CreateData; srcMD := FormatDesc.CreateMappingData; try FormatDesc.PreparePixel(Pixel); src := Data; dst := aImage.PixelData; for y := 0 to Height-1 do for x := 0 to Width-1 do begin FormatDesc.Unmap(src, Pixel, srcMD); case rid.BitsPerPixel of 8: begin dst^ := Pixel.Data.a; inc(dst); end; 16: begin PWord(dst)^ := Pixel.Data.a; inc(dst, 2); end; 24: begin PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0]; PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1]; PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2]; inc(dst, 3); end; 32: begin PCardinal(dst)^ := Pixel.Data.a; inc(dst, 4); end; else raise EglBitmapUnsupportedFormat.Create(Format); end; end; finally FormatDesc.FreeMappingData(srcMD); end; result := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean; var tex: TglBitmap2D; begin tex := TglBitmap2D.Create; try tex.AssignFromLazIntfImage(aImage); result := AddAlphaFromglBitmap(tex, aFunc, aArgs); finally tex.Free; end; end; {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean; var rs: TResourceStream; begin PrepareResType(aResource, aResType); rs := TResourceStream.Create(aInstance, aResource, aResType); try result := AddAlphaFromStream(rs, aFunc, aArgs); finally rs.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean; var rs: TResourceStream; begin rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType); try result := AddAlphaFromStream(rs, aFunc, aArgs); finally rs.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean; begin if TFormatDescriptor.Get(Format).IsCompressed then raise EglBitmapUnsupportedFormat.Create(Format); result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean; var FS: TFileStream; begin FS := TFileStream.Create(aFileName, fmOpenRead); try result := AddAlphaFromStream(FS, aFunc, aArgs); finally FS.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean; var tex: TglBitmap2D; begin tex := TglBitmap2D.Create(aStream); try result := AddAlphaFromglBitmap(tex, aFunc, aArgs); finally tex.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean; var DestData, DestData2, SourceData: pByte; TempHeight, TempWidth: Integer; SourceFD, DestFD: TFormatDescriptor; SourceMD, DestMD, DestMD2: Pointer; FuncRec: TglBitmapFunctionRec; begin result := false; Assert(Assigned(Data)); Assert(Assigned(aBitmap)); Assert(Assigned(aBitmap.Data)); if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha); SourceFD := TFormatDescriptor.Get(aBitmap.Format); DestFD := TFormatDescriptor.Get(Format); if not Assigned(aFunc) then begin aFunc := glBitmapAlphaFunc; FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha); end else FuncRec.Args := aArgs; // Values TempHeight := aBitmap.FileHeight; TempWidth := aBitmap.FileWidth; FuncRec.Sender := Self; FuncRec.Size := Dimension; FuncRec.Position.Fields := FuncRec.Size.Fields; DestData := Data; DestData2 := Data; SourceData := aBitmap.Data; // Mapping SourceFD.PreparePixel(FuncRec.Source); DestFD.PreparePixel (FuncRec.Dest); SourceMD := SourceFD.CreateMappingData; DestMD := DestFD.CreateMappingData; DestMD2 := DestFD.CreateMappingData; try FuncRec.Position.Y := 0; while FuncRec.Position.Y < TempHeight do begin FuncRec.Position.X := 0; while FuncRec.Position.X < TempWidth do begin SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD); DestFD.Unmap (DestData, FuncRec.Dest, DestMD); aFunc(FuncRec); DestFD.Map(FuncRec.Dest, DestData2, DestMD2); inc(FuncRec.Position.X); end; inc(FuncRec.Position.Y); end; finally SourceFD.FreeMappingData(SourceMD); DestFD.FreeMappingData(DestMD); DestFD.FreeMappingData(DestMD2); end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean; begin result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean; var PixelData: TglBitmapPixelData; begin TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData); result := AddAlphaFromColorKeyFloat( aRed / PixelData.Range.r, aGreen / PixelData.Range.g, aBlue / PixelData.Range.b, aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b))); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean; var values: array[0..2] of Single; tmp: Cardinal; i: Integer; PixelData: TglBitmapPixelData; begin TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData); with PixelData do begin values[0] := aRed; values[1] := aGreen; values[2] := aBlue; for i := 0 to 2 do begin tmp := Trunc(Range.arr[i] * aDeviation); Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp)); Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp)); end; Data.a := 0; Range.a := 0; end; result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean; begin result := AddAlphaFromValueFloat(aAlpha / $FF); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean; var PixelData: TglBitmapPixelData; begin TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData); result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean; var PixelData: TglBitmapPixelData; begin TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData); with PixelData do Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha))); result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.RemoveAlpha: Boolean; var FormatDesc: TFormatDescriptor; begin result := false; FormatDesc := TFormatDescriptor.Get(Format); if Assigned(Data) then begin if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then raise EglBitmapUnsupportedFormat.Create(Format); result := ConvertTo(FormatDesc.WithoutAlpha); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.Clone: TglBitmap; var Temp: TglBitmap; TempPtr: PByte; Size: Integer; begin result := nil; Temp := (ClassType.Create as TglBitmap); try // copy texture data if assigned if Assigned(Data) then begin Size := TFormatDescriptor.Get(Format).GetSize(fDimension); GetMem(TempPtr, Size); try Move(Data^, TempPtr^, Size); Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method except if Assigned(TempPtr) then FreeMem(TempPtr); raise; end; end else begin TempPtr := nil; Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method end; // copy properties Temp.fID := ID; Temp.fTarget := Target; Temp.fFormat := Format; Temp.fMipMap := MipMap; Temp.fAnisotropic := Anisotropic; Temp.fBorderColor := fBorderColor; Temp.fDeleteTextureOnFree := DeleteTextureOnFree; Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture; Temp.fFilterMin := fFilterMin; Temp.fFilterMag := fFilterMag; Temp.fWrapS := fWrapS; Temp.fWrapT := fWrapT; Temp.fWrapR := fWrapR; Temp.fFilename := fFilename; Temp.fCustomName := fCustomName; Temp.fCustomNameW := fCustomNameW; Temp.fCustomData := fCustomData; result := Temp; except FreeAndNil(Temp); raise; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean); begin if aUseRGB or aUseAlpha then Convert(glBitmapInvertFunc, false, {%H-}Pointer( ((Byte(aUseAlpha) and 1) shl 1) or (Byte(aUseRGB) and 1) )); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.FreeData; var TempPtr: PByte; begin TempPtr := nil; SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method end; {$IFNDEF OPENGL_ES} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single); begin fBorderColor[0] := aRed; fBorderColor[1] := aGreen; fBorderColor[2] := aBlue; fBorderColor[3] := aAlpha; if (ID > 0) then begin Bind(false); glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]); end; end; {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte); begin FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal); var PixelData: TglBitmapPixelData; begin TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData); FillWithColorFloat( aRed / PixelData.Range.r, aGreen / PixelData.Range.g, aBlue / PixelData.Range.b, aAlpha / PixelData.Range.a); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single); var PixelData: TglBitmapPixelData; begin TFormatDescriptor.Get(Format).PreparePixel(PixelData); with PixelData do begin Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed))); Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen))); Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue))); Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha))); end; Convert(glBitmapFillWithColorFunc, false, @PixelData); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetFilter(const aMin, aMag: GLenum); begin //check MIN filter case aMin of GL_NEAREST: fFilterMin := GL_NEAREST; GL_LINEAR: fFilterMin := GL_LINEAR; GL_NEAREST_MIPMAP_NEAREST: fFilterMin := GL_NEAREST_MIPMAP_NEAREST; GL_LINEAR_MIPMAP_NEAREST: fFilterMin := GL_LINEAR_MIPMAP_NEAREST; GL_NEAREST_MIPMAP_LINEAR: fFilterMin := GL_NEAREST_MIPMAP_LINEAR; GL_LINEAR_MIPMAP_LINEAR: fFilterMin := GL_LINEAR_MIPMAP_LINEAR; else raise EglBitmap.Create('SetFilter - Unknow MIN filter.'); end; //check MAG filter case aMag of GL_NEAREST: fFilterMag := GL_NEAREST; GL_LINEAR: fFilterMag := GL_LINEAR; else raise EglBitmap.Create('SetFilter - Unknow MAG filter.'); end; //apply filter if (ID > 0) then begin Bind(false); glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag); if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin case fFilterMin of GL_NEAREST, GL_LINEAR: glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin); GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR: glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST); GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR: glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR); end; end else glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum); procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal); begin case aValue of {$IFNDEF OPENGL_ES} GL_CLAMP: aTarget := GL_CLAMP; {$ENDIF} GL_REPEAT: aTarget := GL_REPEAT; GL_CLAMP_TO_EDGE: begin {$IFNDEF OPENGL_ES} if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then aTarget := GL_CLAMP else {$ENDIF} aTarget := GL_CLAMP_TO_EDGE; end; {$IFNDEF OPENGL_ES} GL_CLAMP_TO_BORDER: begin if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then aTarget := GL_CLAMP_TO_BORDER else aTarget := GL_CLAMP; end; {$ENDIF} {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)} GL_MIRRORED_REPEAT: begin {$IFNDEF OPENGL_ES} if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then {$ELSE} if GL_VERSION_2_0 then {$ENDIF} aTarget := GL_MIRRORED_REPEAT else raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).'); end; {$IFEND} else raise EglBitmap.Create('SetWrap - Unknow Texturewrap'); end; end; begin CheckAndSetWrap(S, fWrapS); CheckAndSetWrap(T, fWrapT); CheckAndSetWrap(R, fWrapR); if (ID > 0) then begin Bind(false); glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS); glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT); {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF} glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR); {$IFEND} end; end; {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum); procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer); begin if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then fSwizzle[aIndex] := aValue else raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value'); end; begin {$IFNDEF OPENGL_ES} if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then raise EglBitmapNotSupported.Create('texture swizzle is not supported'); {$ELSE} if not GL_VERSION_3_0 then raise EglBitmapNotSupported.Create('texture swizzle is not supported'); {$ENDIF} CheckAndSetValue(r, 0); CheckAndSetValue(g, 1); CheckAndSetValue(b, 2); CheckAndSetValue(a, 3); if (ID > 0) then begin Bind(false); {$IFNDEF OPENGL_ES} glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0])); {$ELSE} glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0])); glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1])); glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2])); glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3])); {$ENDIF} end; end; {$IFEND} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean); begin if aEnableTextureUnit then glEnable(Target); if (ID > 0) then glBindTexture(Target, ID); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean); begin if aDisableTextureUnit then glDisable(Target); glBindTexture(Target, 0); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create; begin if (ClassType = TglBitmap) then raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.'); inherited Create; fFormat := glBitmapGetDefaultFormat; fFreeDataOnDestroy := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create(const aFileName: String); begin Create; LoadFromFile(aFileName); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create(const aStream: TStream); begin Create; LoadFromStream(aStream); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte); var ImageSize: Integer; begin Create; if not Assigned(aData) then begin ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize); GetMem(aData, ImageSize); try FillChar(aData^, ImageSize, #$FF); SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method except if Assigned(aData) then FreeMem(aData); raise; end; end else begin SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer); begin Create; LoadFromFunc(aSize, aFunc, aFormat, aArgs); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar); begin Create; LoadFromResource(aInstance, aResource, aResType); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); begin Create; LoadFromResourceID(aInstance, aResourceID, aResType); end; {$IFDEF GLB_SUPPORT_PNG_READ} {$IF DEFINED(GLB_LAZ_PNG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //PNG///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadPNG(const aStream: TStream): Boolean; const MAGIC_LEN = 8; PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A; var reader: TLazReaderPNG; intf: TLazIntfImage; StreamPos: Int64; magic: String[MAGIC_LEN]; begin result := true; StreamPos := aStream.Position; SetLength(magic, MAGIC_LEN); aStream.Read(magic[1], MAGIC_LEN); aStream.Position := StreamPos; if (magic <> PNG_MAGIC) then begin result := false; exit; end; intf := TLazIntfImage.Create(0, 0); reader := TLazReaderPNG.Create; try try reader.UpdateDescription := true; reader.ImageRead(aStream, intf); AssignFromLazIntfImage(intf); except result := false; aStream.Position := StreamPos; exit; end; finally reader.Free; intf.Free; end; end; {$ELSEIF DEFINED(GLB_SDL_IMAGE)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadPNG(const aStream: TStream): Boolean; var Surface: PSDL_Surface; RWops: PSDL_RWops; begin result := false; RWops := glBitmapCreateRWops(aStream); try if IMG_isPNG(RWops) > 0 then begin Surface := IMG_LoadPNG_RW(RWops); try AssignFromSurface(Surface); result := true; finally SDL_FreeSurface(Surface); end; end; finally SDL_FreeRW(RWops); end; end; {$ELSEIF DEFINED(GLB_LIB_PNG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl; begin TStream(png_get_io_ptr(png)).Read(buffer^, size); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadPNG(const aStream: TStream): Boolean; var StreamPos: Int64; signature: array [0..7] of byte; png: png_structp; png_info: png_infop; TempHeight, TempWidth: Integer; Format: TglBitmapFormat; png_data: pByte; png_rows: array of pByte; Row, LineSize: Integer; begin result := false; if not init_libPNG then raise Exception.Create('LoadPNG - unable to initialize libPNG.'); try // signature StreamPos := aStream.Position; aStream.Read(signature{%H-}, 8); aStream.Position := StreamPos; if png_check_sig(@signature, 8) <> 0 then begin // png read struct png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil); if png = nil then raise EglBitmapException.Create('LoadPng - couldn''t create read struct.'); // png info png_info := png_create_info_struct(png); if png_info = nil then begin png_destroy_read_struct(@png, nil, nil); raise EglBitmapException.Create('LoadPng - couldn''t create info struct.'); end; // set read callback png_set_read_fn(png, aStream, glBitmap_libPNG_read_func); // read informations png_read_info(png, png_info); // size TempHeight := png_get_image_height(png, png_info); TempWidth := png_get_image_width(png, png_info); // format case png_get_color_type(png, png_info) of PNG_COLOR_TYPE_GRAY: Format := tfLuminance8ub1; PNG_COLOR_TYPE_GRAY_ALPHA: Format := tfLuminance8Alpha8us1; PNG_COLOR_TYPE_RGB: Format := tfRGB8ub3; PNG_COLOR_TYPE_RGB_ALPHA: Format := tfRGBA8ub4; else raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.'); end; // cut upper 8 bit from 16 bit formats if png_get_bit_depth(png, png_info) > 8 then png_set_strip_16(png); // expand bitdepth smaller than 8 if png_get_bit_depth(png, png_info) < 8 then png_set_expand(png); // allocating mem for scanlines LineSize := png_get_rowbytes(png, png_info); GetMem(png_data, TempHeight * LineSize); try SetLength(png_rows, TempHeight); for Row := Low(png_rows) to High(png_rows) do begin png_rows[Row] := png_data; Inc(png_rows[Row], Row * LineSize); end; // read complete image into scanlines png_read_image(png, @png_rows[0]); // read end png_read_end(png, png_info); // destroy read struct png_destroy_read_struct(@png, @png_info, nil); SetLength(png_rows, 0); // set new data SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method result := true; except if Assigned(png_data) then FreeMem(png_data); raise; end; end; finally quit_libPNG; end; end; {$ELSEIF DEFINED(GLB_PNGIMAGE)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadPNG(const aStream: TStream): Boolean; var StreamPos: Int64; Png: TPNGObject; Header: String[8]; Row, Col, PixSize, LineSize: Integer; NewImage, pSource, pDest, pAlpha: pByte; PngFormat: TglBitmapFormat; FormatDesc: TFormatDescriptor; const PngHeader: String[8] = #137#80#78#71#13#10#26#10; begin result := false; StreamPos := aStream.Position; aStream.Read(Header[0], SizeOf(Header)); aStream.Position := StreamPos; {Test if the header matches} if Header = PngHeader then begin Png := TPNGObject.Create; try Png.LoadFromStream(aStream); case Png.Header.ColorType of COLOR_GRAYSCALE: PngFormat := tfLuminance8ub1; COLOR_GRAYSCALEALPHA: PngFormat := tfLuminance8Alpha8us1; COLOR_RGB: PngFormat := tfBGR8ub3; COLOR_RGBALPHA: PngFormat := tfBGRA8ub4; else raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.'); end; FormatDesc := TFormatDescriptor.Get(PngFormat); PixSize := Round(FormatDesc.PixelSize); LineSize := FormatDesc.GetSize(Png.Header.Width, 1); GetMem(NewImage, LineSize * Integer(Png.Header.Height)); try pDest := NewImage; case Png.Header.ColorType of COLOR_RGB, COLOR_GRAYSCALE: begin for Row := 0 to Png.Height -1 do begin Move (Png.Scanline[Row]^, pDest^, LineSize); Inc(pDest, LineSize); end; end; COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA: begin PixSize := PixSize -1; for Row := 0 to Png.Height -1 do begin pSource := Png.Scanline[Row]; pAlpha := pByte(Png.AlphaScanline[Row]); for Col := 0 to Png.Width -1 do begin Move (pSource^, pDest^, PixSize); Inc(pSource, PixSize); Inc(pDest, PixSize); pDest^ := pAlpha^; inc(pAlpha); Inc(pDest); end; end; end; else raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.'); end; SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method result := true; except if Assigned(NewImage) then FreeMem(NewImage); raise; end; finally Png.Free; end; end; end; {$IFEND} {$ENDIF} {$IFDEF GLB_SUPPORT_PNG_WRITE} {$IFDEF GLB_LIB_PNG} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl; begin TStream(png_get_io_ptr(png)).Write(buffer^, size); end; {$ENDIF} {$IF DEFINED(GLB_LAZ_PNG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SavePNG(const aStream: TStream); var png: TPortableNetworkGraphic; intf: TLazIntfImage; raw: TRawImage; begin png := TPortableNetworkGraphic.Create; intf := TLazIntfImage.Create(0, 0); try if not AssignToLazIntfImage(intf) then raise EglBitmap.Create('unable to create LazIntfImage from glBitmap'); intf.GetRawImage(raw); png.LoadFromRawImage(raw, false); png.SaveToStream(aStream); finally png.Free; intf.Free; end; end; {$ELSEIF DEFINED(GLB_LIB_PNG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SavePNG(const aStream: TStream); var png: png_structp; png_info: png_infop; png_rows: array of pByte; LineSize: Integer; ColorType: Integer; Row: Integer; FormatDesc: TFormatDescriptor; begin if not (ftPNG in FormatGetSupportedFiles(Format)) then raise EglBitmapUnsupportedFormat.Create(Format); if not init_libPNG then raise Exception.Create('unable to initialize libPNG.'); try case Format of tfAlpha8ub1, tfLuminance8ub1: ColorType := PNG_COLOR_TYPE_GRAY; tfLuminance8Alpha8us1: ColorType := PNG_COLOR_TYPE_GRAY_ALPHA; tfBGR8ub3, tfRGB8ub3: ColorType := PNG_COLOR_TYPE_RGB; tfBGRA8ub4, tfRGBA8ub4: ColorType := PNG_COLOR_TYPE_RGBA; else raise EglBitmapUnsupportedFormat.Create(Format); end; FormatDesc := TFormatDescriptor.Get(Format); LineSize := FormatDesc.GetSize(Width, 1); // creating array for scanline SetLength(png_rows, Height); try for Row := 0 to Height - 1 do begin png_rows[Row] := Data; Inc(png_rows[Row], Row * LineSize) end; // write struct png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil); if png = nil then raise EglBitmapException.Create('SavePng - couldn''t create write struct.'); // create png info png_info := png_create_info_struct(png); if png_info = nil then begin png_destroy_write_struct(@png, nil); raise EglBitmapException.Create('SavePng - couldn''t create info struct.'); end; // set read callback png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil); // set compression png_set_compression_level(png, 6); if Format in [tfBGR8ub3, tfBGRA8ub4] then png_set_bgr(png); png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT); png_write_info(png, png_info); png_write_image(png, @png_rows[0]); png_write_end(png, png_info); png_destroy_write_struct(@png, @png_info); finally SetLength(png_rows, 0); end; finally quit_libPNG; end; end; {$ELSEIF DEFINED(GLB_PNGIMAGE)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SavePNG(const aStream: TStream); var Png: TPNGObject; pSource, pDest: pByte; X, Y, PixSize: Integer; ColorType: Cardinal; Alpha: Boolean; pTemp: pByte; Temp: Byte; begin if not (ftPNG in FormatGetSupportedFiles (Format)) then raise EglBitmapUnsupportedFormat.Create(Format); case Format of tfAlpha8ub1, tfLuminance8ub1: begin ColorType := COLOR_GRAYSCALE; PixSize := 1; Alpha := false; end; tfLuminance8Alpha8us1: begin ColorType := COLOR_GRAYSCALEALPHA; PixSize := 1; Alpha := true; end; tfBGR8ub3, tfRGB8ub3: begin ColorType := COLOR_RGB; PixSize := 3; Alpha := false; end; tfBGRA8ub4, tfRGBA8ub4: begin ColorType := COLOR_RGBALPHA; PixSize := 3; Alpha := true end; else raise EglBitmapUnsupportedFormat.Create(Format); end; Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height); try // Copy ImageData pSource := Data; for Y := 0 to Height -1 do begin pDest := png.ScanLine[Y]; for X := 0 to Width -1 do begin Move(pSource^, pDest^, PixSize); Inc(pDest, PixSize); Inc(pSource, PixSize); if Alpha then begin png.AlphaScanline[Y]^[X] := pSource^; Inc(pSource); end; end; // convert RGB line to BGR if Format in [tfRGB8ub3, tfRGBA8ub4] then begin pTemp := png.ScanLine[Y]; for X := 0 to Width -1 do begin Temp := pByteArray(pTemp)^[0]; pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2]; pByteArray(pTemp)^[2] := Temp; Inc(pTemp, 3); end; end; end; // Save to Stream Png.CompressionLevel := 6; Png.SaveToStream(aStream); finally FreeAndNil(Png); end; end; {$IFEND} {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //JPEG//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// {$IFDEF GLB_LIB_JPEG} type glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr; glBitmap_libJPEG_source_mgr = record pub: jpeg_source_mgr; SrcStream: TStream; SrcBuffer: array [1..4096] of byte; end; glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr; glBitmap_libJPEG_dest_mgr = record pub: jpeg_destination_mgr; DestStream: TStream; DestBuffer: array [1..4096] of byte; end; procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl; begin //DUMMY end; procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl; begin //DUMMY end; procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl; begin //DUMMY end; procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl; begin //DUMMY end; procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl; begin //DUMMY end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl; var src: glBitmap_libJPEG_source_mgr_ptr; bytes: integer; begin src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src); bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096); if (bytes <= 0) then begin src^.SrcBuffer[1] := $FF; src^.SrcBuffer[2] := JPEG_EOI; bytes := 2; end; src^.pub.next_input_byte := @(src^.SrcBuffer[1]); src^.pub.bytes_in_buffer := bytes; result := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl; var src: glBitmap_libJPEG_source_mgr_ptr; begin src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src); if num_bytes > 0 then begin // wanted byte isn't in buffer so set stream position and read buffer if num_bytes > src^.pub.bytes_in_buffer then begin src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer; src^.pub.fill_input_buffer(cinfo); end else begin // wanted byte is in buffer so only skip inc(src^.pub.next_input_byte, num_bytes); dec(src^.pub.bytes_in_buffer, num_bytes); end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl; var dest: glBitmap_libJPEG_dest_mgr_ptr; begin dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest); if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin // write complete buffer dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer)); // reset buffer dest^.pub.next_output_byte := @dest^.DestBuffer[1]; dest^.pub.free_in_buffer := Length(dest^.DestBuffer); end; result := true; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl; var Idx: Integer; dest: glBitmap_libJPEG_dest_mgr_ptr; begin dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest); for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin // check for endblock if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin // write endblock dest^.DestStream.Write(dest^.DestBuffer[Idx], 2); // leave break; end else dest^.DestStream.Write(dest^.DestBuffer[Idx], 1); end; end; {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_READ} {$IF DEFINED(GLB_LAZ_JPEG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadJPEG(const aStream: TStream): Boolean; const MAGIC_LEN = 2; JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8; var intf: TLazIntfImage; reader: TFPReaderJPEG; StreamPos: Int64; magic: String[MAGIC_LEN]; begin result := true; StreamPos := aStream.Position; SetLength(magic, MAGIC_LEN); aStream.Read(magic[1], MAGIC_LEN); aStream.Position := StreamPos; if (magic <> JPEG_MAGIC) then begin result := false; exit; end; reader := TFPReaderJPEG.Create; intf := TLazIntfImage.Create(0, 0); try try intf.DataDescription := GetDescriptionFromDevice(0, 0, 0); reader.ImageRead(aStream, intf); AssignFromLazIntfImage(intf); except result := false; aStream.Position := StreamPos; exit; end; finally reader.Free; intf.Free; end; end; {$ELSEIF DEFINED(GLB_SDL_IMAGE)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadJPEG(const aStream: TStream): Boolean; var Surface: PSDL_Surface; RWops: PSDL_RWops; begin result := false; RWops := glBitmapCreateRWops(aStream); try if IMG_isJPG(RWops) > 0 then begin Surface := IMG_LoadJPG_RW(RWops); try AssignFromSurface(Surface); result := true; finally SDL_FreeSurface(Surface); end; end; finally SDL_FreeRW(RWops); end; end; {$ELSEIF DEFINED(GLB_LIB_JPEG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadJPEG(const aStream: TStream): Boolean; var StreamPos: Int64; Temp: array[0..1]of Byte; jpeg: jpeg_decompress_struct; jpeg_err: jpeg_error_mgr; IntFormat: TglBitmapFormat; pImage: pByte; TempHeight, TempWidth: Integer; pTemp: pByte; Row: Integer; FormatDesc: TFormatDescriptor; begin result := false; if not init_libJPEG then raise Exception.Create('LoadJPG - unable to initialize libJPEG.'); try // reading first two bytes to test file and set cursor back to begin StreamPos := aStream.Position; aStream.Read({%H-}Temp[0], 2); aStream.Position := StreamPos; // if Bitmap then read file. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00); FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00); // error managment jpeg.err := jpeg_std_error(@jpeg_err); jpeg_err.error_exit := glBitmap_libJPEG_error_exit; jpeg_err.output_message := glBitmap_libJPEG_output_message; // decompression struct jpeg_create_decompress(@jpeg); // allocation space for streaming methods jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr)); // seeting up custom functions with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin pub.init_source := glBitmap_libJPEG_init_source; pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer; pub.skip_input_data := glBitmap_libJPEG_skip_input_data; pub.resync_to_restart := jpeg_resync_to_restart; // use default method pub.term_source := glBitmap_libJPEG_term_source; pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read pub.next_input_byte := nil; // until buffer loaded SrcStream := aStream; end; // set global decoding state jpeg.global_state := DSTATE_START; // read header of jpeg jpeg_read_header(@jpeg, false); // setting output parameter case jpeg.jpeg_color_space of JCS_GRAYSCALE: begin jpeg.out_color_space := JCS_GRAYSCALE; IntFormat := tfLuminance8ub1; end; else jpeg.out_color_space := JCS_RGB; IntFormat := tfRGB8ub3; end; // reading image jpeg_start_decompress(@jpeg); TempHeight := jpeg.output_height; TempWidth := jpeg.output_width; FormatDesc := TFormatDescriptor.Get(IntFormat); // creating new image GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight)); try pTemp := pImage; for Row := 0 to TempHeight -1 do begin jpeg_read_scanlines(@jpeg, @pTemp, 1); Inc(pTemp, FormatDesc.GetSize(TempWidth, 1)); end; // finish decompression jpeg_finish_decompress(@jpeg); // destroy decompression jpeg_destroy_decompress(@jpeg); SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method result := true; except if Assigned(pImage) then FreeMem(pImage); raise; end; end; finally quit_libJPEG; end; end; {$ELSEIF DEFINED(GLB_DELPHI_JPEG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadJPEG(const aStream: TStream): Boolean; var bmp: TBitmap; jpg: TJPEGImage; StreamPos: Int64; Temp: array[0..1]of Byte; begin result := false; // reading first two bytes to test file and set cursor back to begin StreamPos := aStream.Position; aStream.Read(Temp[0], 2); aStream.Position := StreamPos; // if Bitmap then read file. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin bmp := TBitmap.Create; try jpg := TJPEGImage.Create; try jpg.LoadFromStream(aStream); bmp.Assign(jpg); result := AssignFromBitmap(bmp); finally jpg.Free; end; finally bmp.Free; end; end; end; {$IFEND} {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_WRITE} {$IF DEFINED(GLB_LAZ_JPEG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveJPEG(const aStream: TStream); var jpeg: TJPEGImage; intf: TLazIntfImage; raw: TRawImage; begin jpeg := TJPEGImage.Create; intf := TLazIntfImage.Create(0, 0); try if not AssignToLazIntfImage(intf) then raise EglBitmap.Create('unable to create LazIntfImage from glBitmap'); intf.GetRawImage(raw); jpeg.LoadFromRawImage(raw, false); jpeg.SaveToStream(aStream); finally intf.Free; jpeg.Free; end; end; {$ELSEIF DEFINED(GLB_LIB_JPEG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveJPEG(const aStream: TStream); var jpeg: jpeg_compress_struct; jpeg_err: jpeg_error_mgr; Row: Integer; pTemp, pTemp2: pByte; procedure CopyRow(pDest, pSource: pByte); var X: Integer; begin for X := 0 to Width - 1 do begin pByteArray(pDest)^[0] := pByteArray(pSource)^[2]; pByteArray(pDest)^[1] := pByteArray(pSource)^[1]; pByteArray(pDest)^[2] := pByteArray(pSource)^[0]; Inc(pDest, 3); Inc(pSource, 3); end; end; begin if not (ftJPEG in FormatGetSupportedFiles(Format)) then raise EglBitmapUnsupportedFormat.Create(Format); if not init_libJPEG then raise Exception.Create('SaveJPG - unable to initialize libJPEG.'); try FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00); FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00); // error managment jpeg.err := jpeg_std_error(@jpeg_err); jpeg_err.error_exit := glBitmap_libJPEG_error_exit; jpeg_err.output_message := glBitmap_libJPEG_output_message; // compression struct jpeg_create_compress(@jpeg); // allocation space for streaming methods jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr)); // seeting up custom functions with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin pub.init_destination := glBitmap_libJPEG_init_destination; pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer; pub.term_destination := glBitmap_libJPEG_term_destination; pub.next_output_byte := @DestBuffer[1]; pub.free_in_buffer := Length(DestBuffer); DestStream := aStream; end; // very important state jpeg.global_state := CSTATE_START; jpeg.image_width := Width; jpeg.image_height := Height; case Format of tfAlpha8ub1, tfLuminance8ub1: begin jpeg.input_components := 1; jpeg.in_color_space := JCS_GRAYSCALE; end; tfRGB8ub3, tfBGR8ub3: begin jpeg.input_components := 3; jpeg.in_color_space := JCS_RGB; end; end; jpeg_set_defaults(@jpeg); jpeg_set_quality(@jpeg, 95, true); jpeg_start_compress(@jpeg, true); pTemp := Data; if Format = tfBGR8ub3 then GetMem(pTemp2, fRowSize) else pTemp2 := pTemp; try for Row := 0 to jpeg.image_height -1 do begin // prepare row if Format = tfBGR8ub3 then CopyRow(pTemp2, pTemp) else pTemp2 := pTemp; // write row jpeg_write_scanlines(@jpeg, @pTemp2, 1); inc(pTemp, fRowSize); end; finally // free memory if Format = tfBGR8ub3 then FreeMem(pTemp2); end; jpeg_finish_compress(@jpeg); jpeg_destroy_compress(@jpeg); finally quit_libJPEG; end; end; {$ELSEIF DEFINED(GLB_DELPHI_JPEG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveJPEG(const aStream: TStream); var Bmp: TBitmap; Jpg: TJPEGImage; begin if not (ftJPEG in FormatGetSupportedFiles(Format)) then raise EglBitmapUnsupportedFormat.Create(Format); Bmp := TBitmap.Create; try Jpg := TJPEGImage.Create; try AssignToBitmap(Bmp); if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin Jpg.Grayscale := true; Jpg.PixelFormat := jf8Bit; end; Jpg.Assign(Bmp); Jpg.SaveToStream(aStream); finally FreeAndNil(Jpg); end; finally FreeAndNil(Bmp); end; end; {$IFEND} {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //RAW///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// type RawHeader = packed record Magic: String[5]; Version: Byte; Width: Integer; Height: Integer; DataSize: Integer; BitsPerPixel: Integer; Precision: TglBitmapRec4ub; Shift: TglBitmapRec4ub; end; function TglBitmap.LoadRAW(const aStream: TStream): Boolean; var header: RawHeader; StartPos: Int64; fd: TFormatDescriptor; buf: PByte; begin result := false; StartPos := aStream.Position; aStream.Read(header{%H-}, SizeOf(header)); if (header.Magic <> 'glBMP') then begin aStream.Position := StartPos; exit; end; fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel); if (fd.Format = tfEmpty) then raise EglBitmapUnsupportedFormat.Create('no supported format found'); buf := GetMemory(header.DataSize); aStream.Read(buf^, header.DataSize); SetDataPointer(buf, fd.Format, header.Width, header.Height); result := true; end; procedure TglBitmap.SaveRAW(const aStream: TStream); var header: RawHeader; fd: TFormatDescriptor; begin fd := TFormatDescriptor.Get(Format); header.Magic := 'glBMP'; header.Version := 1; header.Width := Width; header.Height := Height; header.DataSize := fd.GetSize(fDimension); header.BitsPerPixel := fd.BitsPerPixel; header.Precision := fd.Precision; header.Shift := fd.Shift; aStream.Write(header, SizeOf(header)); aStream.Write(Data^, header.DataSize); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //BMP///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// const BMP_MAGIC = $4D42; BMP_COMP_RGB = 0; BMP_COMP_RLE8 = 1; BMP_COMP_RLE4 = 2; BMP_COMP_BITFIELDS = 3; type TBMPHeader = packed record bfType: Word; bfSize: Cardinal; bfReserved1: Word; bfReserved2: Word; bfOffBits: Cardinal; end; TBMPInfo = packed record biSize: Cardinal; biWidth: Longint; biHeight: Longint; biPlanes: Word; biBitCount: Word; biCompression: Cardinal; biSizeImage: Cardinal; biXPelsPerMeter: Longint; biYPelsPerMeter: Longint; biClrUsed: Cardinal; biClrImportant: Cardinal; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadBMP(const aStream: TStream): Boolean; ////////////////////////////////////////////////////////////////////////////////////////////////// function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat; begin result := tfEmpty; aStream.Read(aInfo{%H-}, SizeOf(aInfo)); FillChar(aMask{%H-}, SizeOf(aMask), 0); //Read Compression case aInfo.biCompression of BMP_COMP_RLE4, BMP_COMP_RLE8: begin raise EglBitmap.Create('RLE compression is not supported'); end; BMP_COMP_BITFIELDS: begin if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin aStream.Read(aMask.r, SizeOf(aMask.r)); aStream.Read(aMask.g, SizeOf(aMask.g)); aStream.Read(aMask.b, SizeOf(aMask.b)); aStream.Read(aMask.a, SizeOf(aMask.a)); end else raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats'); end; end; //get suitable format case aInfo.biBitCount of 8: result := tfLuminance8ub1; 16: result := tfX1RGB5us1; 24: result := tfBGR8ub3; 32: result := tfXRGB8ui1; end; end; function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat; var i, c: Integer; ColorTable: TbmpColorTable; begin result := nil; if (aInfo.biBitCount >= 16) then exit; aFormat := tfLuminance8ub1; c := aInfo.biClrUsed; if (c = 0) then c := 1 shl aInfo.biBitCount; SetLength(ColorTable, c); for i := 0 to c-1 do begin aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty)); if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then aFormat := tfRGB8ub3; end; result := TbmpColorTableFormat.Create; result.BitsPerPixel := aInfo.biBitCount; result.ColorTable := ColorTable; result.CalcValues; end; ////////////////////////////////////////////////////////////////////////////////////////////////// function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat; var FormatDesc: TFormatDescriptor; begin result := nil; if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin FormatDesc := TFormatDescriptor.GetFromMask(aMask); if (FormatDesc.Format = tfEmpty) then exit; aFormat := FormatDesc.Format; if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha; if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then aFormat := TFormatDescriptor.Get(aFormat).WithAlpha; result := TbmpBitfieldFormat.Create; result.SetCustomValues(aInfo.biBitCount, aMask); end; end; var //simple types StartPos: Int64; ImageSize, rbLineSize, wbLineSize, Padding, i: Integer; PaddingBuff: Cardinal; LineBuf, ImageData, TmpData: PByte; SourceMD, DestMD: Pointer; BmpFormat: TglBitmapFormat; //records Mask: TglBitmapRec4ul; Header: TBMPHeader; Info: TBMPInfo; //classes SpecialFormat: TFormatDescriptor; FormatDesc: TFormatDescriptor; ////////////////////////////////////////////////////////////////////////////////////////////////// procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte); var i: Integer; Pixel: TglBitmapPixelData; begin aStream.Read(aLineBuf^, rbLineSize); SpecialFormat.PreparePixel(Pixel); for i := 0 to Info.biWidth-1 do begin SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD); glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc); FormatDesc.Map(Pixel, aData, DestMD); end; end; begin result := false; BmpFormat := tfEmpty; SpecialFormat := nil; LineBuf := nil; SourceMD := nil; DestMD := nil; // Header StartPos := aStream.Position; aStream.Read(Header{%H-}, SizeOf(Header)); if Header.bfType = BMP_MAGIC then begin try try BmpFormat := ReadInfo(Info, Mask); SpecialFormat := ReadColorTable(BmpFormat, Info); if not Assigned(SpecialFormat) then SpecialFormat := CheckBitfields(BmpFormat, Mask, Info); aStream.Position := StartPos + Header.bfOffBits; if (BmpFormat <> tfEmpty) then begin FormatDesc := TFormatDescriptor.Get(BmpFormat); rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel); Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize; //get Memory DestMD := FormatDesc.CreateMappingData; ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight)); GetMem(ImageData, ImageSize); if Assigned(SpecialFormat) then begin GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields SourceMD := SpecialFormat.CreateMappingData; end; //read Data try try FillChar(ImageData^, ImageSize, $FF); TmpData := ImageData; if (Info.biHeight > 0) then Inc(TmpData, wbLineSize * (Info.biHeight-1)); for i := 0 to Abs(Info.biHeight)-1 do begin if Assigned(SpecialFormat) then SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data else aStream.Read(TmpData^, wbLineSize); //else only read data if (Info.biHeight > 0) then dec(TmpData, wbLineSize) else inc(TmpData, wbLineSize); aStream.Read(PaddingBuff{%H-}, Padding); end; SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method result := true; finally if Assigned(LineBuf) then FreeMem(LineBuf); if Assigned(SourceMD) then SpecialFormat.FreeMappingData(SourceMD); FormatDesc.FreeMappingData(DestMD); end; except if Assigned(ImageData) then FreeMem(ImageData); raise; end; end else raise EglBitmap.Create('LoadBMP - No suitable format found'); except aStream.Position := StartPos; raise; end; finally FreeAndNil(SpecialFormat); end; end else aStream.Position := StartPos; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveBMP(const aStream: TStream); var Header: TBMPHeader; Info: TBMPInfo; Converter: TFormatDescriptor; FormatDesc: TFormatDescriptor; SourceFD, DestFD: Pointer; pData, srcData, dstData, ConvertBuffer: pByte; Pixel: TglBitmapPixelData; ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer; RedMask, GreenMask, BlueMask, AlphaMask: Cardinal; PaddingBuff: Cardinal; function GetLineWidth : Integer; begin result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3; end; begin if not (ftBMP in FormatGetSupportedFiles(Format)) then raise EglBitmapUnsupportedFormat.Create(Format); Converter := nil; FormatDesc := TFormatDescriptor.Get(Format); ImageSize := FormatDesc.GetSize(Dimension); FillChar(Header{%H-}, SizeOf(Header), 0); Header.bfType := BMP_MAGIC; Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize; Header.bfReserved1 := 0; Header.bfReserved2 := 0; Header.bfOffBits := SizeOf(Header) + SizeOf(Info); FillChar(Info{%H-}, SizeOf(Info), 0); Info.biSize := SizeOf(Info); Info.biWidth := Width; Info.biHeight := Height; Info.biPlanes := 1; Info.biCompression := BMP_COMP_RGB; Info.biSizeImage := ImageSize; try case Format of tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1: begin Info.biBitCount := 8; Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal); Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries Converter := TbmpColorTableFormat.Create; with (Converter as TbmpColorTableFormat) do begin SetCustomValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift); CreateColorTable; end; end; tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2, tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1, tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1: begin Info.biBitCount := 16; Info.biCompression := BMP_COMP_BITFIELDS; end; tfBGR8ub3, tfRGB8ub3: begin Info.biBitCount := 24; if (Format = tfRGB8ub3) then Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values end; tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1, tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1: begin Info.biBitCount := 32; Info.biCompression := BMP_COMP_BITFIELDS; end; else raise EglBitmapUnsupportedFormat.Create(Format); end; Info.biXPelsPerMeter := 2835; Info.biYPelsPerMeter := 2835; // prepare bitmasks if Info.biCompression = BMP_COMP_BITFIELDS then begin Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal); Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal); RedMask := FormatDesc.Mask.r; GreenMask := FormatDesc.Mask.g; BlueMask := FormatDesc.Mask.b; AlphaMask := FormatDesc.Mask.a; end; // headers aStream.Write(Header, SizeOf(Header)); aStream.Write(Info, SizeOf(Info)); // colortable if Assigned(Converter) and (Converter is TbmpColorTableFormat) then with (Converter as TbmpColorTableFormat) do aStream.Write(ColorTable[0].b, SizeOf(TbmpColorTableEnty) * Length(ColorTable)); // bitmasks if Info.biCompression = BMP_COMP_BITFIELDS then begin aStream.Write(RedMask, SizeOf(Cardinal)); aStream.Write(GreenMask, SizeOf(Cardinal)); aStream.Write(BlueMask, SizeOf(Cardinal)); aStream.Write(AlphaMask, SizeOf(Cardinal)); end; // image data rbLineSize := Round(Info.biWidth * FormatDesc.BytesPerPixel); wbLineSize := Round(Info.biWidth * Info.biBitCount / 8); Padding := GetLineWidth - wbLineSize; PaddingBuff := 0; pData := Data; inc(pData, (Height-1) * rbLineSize); // prepare row buffer. But only for RGB because RGBA supports color masks // so it's possible to change color within the image. if Assigned(Converter) then begin FormatDesc.PreparePixel(Pixel); GetMem(ConvertBuffer, wbLineSize); SourceFD := FormatDesc.CreateMappingData; DestFD := Converter.CreateMappingData; end else ConvertBuffer := nil; try for LineIdx := 0 to Height - 1 do begin // preparing row if Assigned(Converter) then begin srcData := pData; dstData := ConvertBuffer; for PixelIdx := 0 to Info.biWidth-1 do begin FormatDesc.Unmap(srcData, Pixel, SourceFD); glBitmapConvertPixel(Pixel, FormatDesc, Converter); Converter.Map(Pixel, dstData, DestFD); end; aStream.Write(ConvertBuffer^, wbLineSize); end else begin aStream.Write(pData^, rbLineSize); end; dec(pData, rbLineSize); if (Padding > 0) then aStream.Write(PaddingBuff, Padding); end; finally // destroy row buffer if Assigned(ConvertBuffer) then begin FormatDesc.FreeMappingData(SourceFD); Converter.FreeMappingData(DestFD); FreeMem(ConvertBuffer); end; end; finally if Assigned(Converter) then Converter.Free; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TGA///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// type TTGAHeader = packed record ImageID: Byte; ColorMapType: Byte; ImageType: Byte; //ColorMapSpec: Array[0..4] of Byte; ColorMapStart: Word; ColorMapLength: Word; ColorMapEntrySize: Byte; OrigX: Word; OrigY: Word; Width: Word; Height: Word; Bpp: Byte; ImageDesc: Byte; end; const TGA_UNCOMPRESSED_RGB = 2; TGA_UNCOMPRESSED_GRAY = 3; TGA_COMPRESSED_RGB = 10; TGA_COMPRESSED_GRAY = 11; TGA_NONE_COLOR_TABLE = 0; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadTGA(const aStream: TStream): Boolean; var Header: TTGAHeader; ImageData: System.PByte; StartPosition: Int64; PixelSize, LineSize: Integer; tgaFormat: TglBitmapFormat; FormatDesc: TFormatDescriptor; Counter: packed record X, Y: packed record low, high, dir: Integer; end; end; const CACHE_SIZE = $4000; //////////////////////////////////////////////////////////////////////////////////////// procedure ReadUncompressed; var i, j: Integer; buf, tmp1, tmp2: System.PByte; begin buf := nil; if (Counter.X.dir < 0) then GetMem(buf, LineSize); try while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin tmp1 := ImageData; inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart if (Counter.X.dir < 0) then begin //flip X aStream.Read(buf^, LineSize); tmp2 := buf; inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line for i := 0 to Header.Width-1 do begin //for all pixels in line for j := 0 to PixelSize-1 do begin //for all bytes in pixel tmp1^ := tmp2^; inc(tmp1); inc(tmp2); end; dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward end; end else aStream.Read(tmp1^, LineSize); inc(Counter.Y.low, Counter.Y.dir); //move to next line index end; finally if Assigned(buf) then FreeMem(buf); end; end; //////////////////////////////////////////////////////////////////////////////////////// procedure ReadCompressed; ///////////////////////////////////////////////////////////////// var TmpData: System.PByte; LinePixelsRead: Integer; procedure CheckLine; begin if (LinePixelsRead >= Header.Width) then begin LinePixelsRead := 0; inc(Counter.Y.low, Counter.Y.dir); //next line index TmpData := ImageData; inc(TmpData, Counter.Y.low * LineSize); //set line if (Counter.X.dir < 0) then //if x flipped then inc(TmpData, LineSize - PixelSize); //set last pixel end; end; ///////////////////////////////////////////////////////////////// var Cache: PByte; CacheSize, CachePos: Integer; procedure CachedRead(out Buffer; Count: Integer); var BytesRead: Integer; begin if (CachePos + Count > CacheSize) then begin //if buffer overflow save non read bytes BytesRead := 0; if (CacheSize - CachePos > 0) then begin BytesRead := CacheSize - CachePos; Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead); inc(CachePos, BytesRead); end; //load cache from file CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position); aStream.Read(Cache^, CacheSize); CachePos := 0; //read rest of requested bytes if (Count - BytesRead > 0) then begin Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead); inc(CachePos, Count - BytesRead); end; end else begin //if no buffer overflow just read the data Move(PByteArray(Cache)^[CachePos], Buffer, Count); inc(CachePos, Count); end; end; procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte); begin case PixelSize of 1: begin aBuffer^ := aData^; inc(aBuffer, Counter.X.dir); end; 2: begin PWord(aBuffer)^ := PWord(aData)^; inc(aBuffer, 2 * Counter.X.dir); end; 3: begin PByteArray(aBuffer)^[0] := PByteArray(aData)^[0]; PByteArray(aBuffer)^[1] := PByteArray(aData)^[1]; PByteArray(aBuffer)^[2] := PByteArray(aData)^[2]; inc(aBuffer, 3 * Counter.X.dir); end; 4: begin PCardinal(aBuffer)^ := PCardinal(aData)^; inc(aBuffer, 4 * Counter.X.dir); end; end; end; var TotalPixelsToRead, TotalPixelsRead: Integer; Temp: Byte; buf: array [0..3] of Byte; //1 pixel is max 32bit long PixelRepeat: Boolean; PixelsToRead, PixelCount: Integer; begin CacheSize := 0; CachePos := 0; TotalPixelsToRead := Header.Width * Header.Height; TotalPixelsRead := 0; LinePixelsRead := 0; GetMem(Cache, CACHE_SIZE); try TmpData := ImageData; inc(TmpData, Counter.Y.low * LineSize); //set line if (Counter.X.dir < 0) then //if x flipped then inc(TmpData, LineSize - PixelSize); //set last pixel repeat //read CommandByte CachedRead(Temp, 1); PixelRepeat := (Temp and $80) > 0; PixelsToRead := (Temp and $7F) + 1; inc(TotalPixelsRead, PixelsToRead); if PixelRepeat then CachedRead(buf[0], PixelSize); while (PixelsToRead > 0) do begin CheckLine; PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF while (PixelCount > 0) do begin if not PixelRepeat then CachedRead(buf[0], PixelSize); PixelToBuffer(@buf[0], TmpData); inc(LinePixelsRead); dec(PixelsToRead); dec(PixelCount); end; end; until (TotalPixelsRead >= TotalPixelsToRead); finally FreeMem(Cache); end; end; function IsGrayFormat: Boolean; begin result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY]; end; begin result := false; // reading header to test file and set cursor back to begin StartPosition := aStream.Position; aStream.Read(Header{%H-}, SizeOf(Header)); // no colormapped files if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [ TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then begin try if Header.ImageID <> 0 then // skip image ID aStream.Position := aStream.Position + Header.ImageID; tgaFormat := tfEmpty; case Header.Bpp of 8: if IsGrayFormat then case (Header.ImageDesc and $F) of 0: tgaFormat := tfLuminance8ub1; 8: tgaFormat := tfAlpha8ub1; end; 16: if IsGrayFormat then case (Header.ImageDesc and $F) of 0: tgaFormat := tfLuminance16us1; 8: tgaFormat := tfLuminance8Alpha8ub2; end else case (Header.ImageDesc and $F) of 0: tgaFormat := tfX1RGB5us1; 1: tgaFormat := tfA1RGB5us1; 4: tgaFormat := tfARGB4us1; end; 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of 0: tgaFormat := tfBGR8ub3; end; 32: if IsGrayFormat then case (Header.ImageDesc and $F) of 0: tgaFormat := tfDepth32ui1; end else case (Header.ImageDesc and $F) of 0: tgaFormat := tfX2RGB10ui1; 2: tgaFormat := tfA2RGB10ui1; 8: tgaFormat := tfARGB8ui1; end; end; if (tgaFormat = tfEmpty) then raise EglBitmap.Create('LoadTga - unsupported format'); FormatDesc := TFormatDescriptor.Get(tgaFormat); PixelSize := FormatDesc.GetSize(1, 1); LineSize := FormatDesc.GetSize(Header.Width, 1); GetMem(ImageData, LineSize * Header.Height); try //column direction if ((Header.ImageDesc and (1 shl 4)) > 0) then begin Counter.X.low := Header.Height-1;; Counter.X.high := 0; Counter.X.dir := -1; end else begin Counter.X.low := 0; Counter.X.high := Header.Height-1; Counter.X.dir := 1; end; // Row direction if ((Header.ImageDesc and (1 shl 5)) > 0) then begin Counter.Y.low := 0; Counter.Y.high := Header.Height-1; Counter.Y.dir := 1; end else begin Counter.Y.low := Header.Height-1;; Counter.Y.high := 0; Counter.Y.dir := -1; end; // Read Image case Header.ImageType of TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY: ReadUncompressed; TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY: ReadCompressed; end; SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method result := true; except if Assigned(ImageData) then FreeMem(ImageData); raise; end; finally aStream.Position := StartPosition; end; end else aStream.Position := StartPosition; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveTGA(const aStream: TStream); var Header: TTGAHeader; Size: Integer; FormatDesc: TFormatDescriptor; begin if not (ftTGA in FormatGetSupportedFiles(Format)) then raise EglBitmapUnsupportedFormat.Create(Format); //prepare header FormatDesc := TFormatDescriptor.Get(Format); FillChar(Header{%H-}, SizeOf(Header), 0); Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F; Header.Bpp := FormatDesc.BitsPerPixel; Header.Width := Width; Header.Height := Height; Header.ImageDesc := Header.ImageDesc or $20; //flip y if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then Header.ImageType := TGA_UNCOMPRESSED_GRAY else Header.ImageType := TGA_UNCOMPRESSED_RGB; aStream.Write(Header, SizeOf(Header)); // write Data Size := FormatDesc.GetSize(Dimension); aStream.Write(Data^, Size); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //DDS///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// const DDS_MAGIC: Cardinal = $20534444; // DDS_header.dwFlags DDSD_CAPS = $00000001; DDSD_HEIGHT = $00000002; DDSD_WIDTH = $00000004; DDSD_PIXELFORMAT = $00001000; // DDS_header.sPixelFormat.dwFlags DDPF_ALPHAPIXELS = $00000001; DDPF_ALPHA = $00000002; DDPF_FOURCC = $00000004; DDPF_RGB = $00000040; DDPF_LUMINANCE = $00020000; // DDS_header.sCaps.dwCaps1 DDSCAPS_TEXTURE = $00001000; // DDS_header.sCaps.dwCaps2 DDSCAPS2_CUBEMAP = $00000200; D3DFMT_DXT1 = $31545844; D3DFMT_DXT3 = $33545844; D3DFMT_DXT5 = $35545844; type TDDSPixelFormat = packed record dwSize: Cardinal; dwFlags: Cardinal; dwFourCC: Cardinal; dwRGBBitCount: Cardinal; dwRBitMask: Cardinal; dwGBitMask: Cardinal; dwBBitMask: Cardinal; dwABitMask: Cardinal; end; TDDSCaps = packed record dwCaps1: Cardinal; dwCaps2: Cardinal; dwDDSX: Cardinal; dwReserved: Cardinal; end; TDDSHeader = packed record dwSize: Cardinal; dwFlags: Cardinal; dwHeight: Cardinal; dwWidth: Cardinal; dwPitchOrLinearSize: Cardinal; dwDepth: Cardinal; dwMipMapCount: Cardinal; dwReserved: array[0..10] of Cardinal; PixelFormat: TDDSPixelFormat; Caps: TDDSCaps; dwReserved2: Cardinal; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.LoadDDS(const aStream: TStream): Boolean; var Header: TDDSHeader; Converter: TbmpBitfieldFormat; function GetDDSFormat: TglBitmapFormat; var fd: TFormatDescriptor; i: Integer; Mask: TglBitmapRec4ul; Range: TglBitmapRec4ui; match: Boolean; begin result := tfEmpty; with Header.PixelFormat do begin // Compresses if ((dwFlags and DDPF_FOURCC) > 0) then begin case Header.PixelFormat.dwFourCC of D3DFMT_DXT1: result := tfS3tcDtx1RGBA; D3DFMT_DXT3: result := tfS3tcDtx3RGBA; D3DFMT_DXT5: result := tfS3tcDtx5RGBA; end; end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin // prepare masks if ((dwFlags and DDPF_LUMINANCE) = 0) then begin Mask.r := dwRBitMask; Mask.g := dwGBitMask; Mask.b := dwBBitMask; end else begin Mask.r := dwRBitMask; Mask.g := dwRBitMask; Mask.b := dwRBitMask; end; if (dwFlags and DDPF_ALPHAPIXELS > 0) then Mask.a := dwABitMask else Mask.a := 0;; //find matching format fd := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount); result := fd.Format; if (result <> tfEmpty) then exit; //find format with same Range for i := 0 to 3 do Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1; for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin fd := TFormatDescriptor.Get(result); match := true; for i := 0 to 3 do if (fd.Range.arr[i] <> Range.arr[i]) then begin match := false; break; end; if match then break; end; //no format with same range found -> use default if (result = tfEmpty) then begin if (dwABitMask > 0) then result := tfRGBA8ui1 else result := tfRGB8ub3; end; Converter := TbmpBitfieldFormat.Create; Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask)); end; end; end; var StreamPos: Int64; x, y, LineSize, RowSize, Magic: Cardinal; NewImage, TmpData, RowData, SrcData: System.PByte; SourceMD, DestMD: Pointer; Pixel: TglBitmapPixelData; ddsFormat: TglBitmapFormat; FormatDesc: TFormatDescriptor; begin result := false; Converter := nil; StreamPos := aStream.Position; // Magic aStream.Read(Magic{%H-}, sizeof(Magic)); if (Magic <> DDS_MAGIC) then begin aStream.Position := StreamPos; exit; end; //Header aStream.Read(Header{%H-}, sizeof(Header)); if (Header.dwSize <> SizeOf(Header)) or ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <> (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then begin aStream.Position := StreamPos; exit; end; if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then raise EglBitmap.Create('LoadDDS - CubeMaps are not supported'); ddsFormat := GetDDSFormat; try if (ddsFormat = tfEmpty) then raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.'); FormatDesc := TFormatDescriptor.Get(ddsFormat); LineSize := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel); GetMem(NewImage, Header.dwHeight * LineSize); try TmpData := NewImage; //Converter needed if Assigned(Converter) then begin RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8); GetMem(RowData, RowSize); SourceMD := Converter.CreateMappingData; DestMD := FormatDesc.CreateMappingData; try for y := 0 to Header.dwHeight-1 do begin TmpData := NewImage; inc(TmpData, y * LineSize); SrcData := RowData; aStream.Read(SrcData^, RowSize); for x := 0 to Header.dwWidth-1 do begin Converter.Unmap(SrcData, Pixel, SourceMD); glBitmapConvertPixel(Pixel, Converter, FormatDesc); FormatDesc.Map(Pixel, TmpData, DestMD); end; end; finally Converter.FreeMappingData(SourceMD); FormatDesc.FreeMappingData(DestMD); FreeMem(RowData); end; end else // Compressed if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin RowSize := Header.dwPitchOrLinearSize div Header.dwWidth; for Y := 0 to Header.dwHeight-1 do begin aStream.Read(TmpData^, RowSize); Inc(TmpData, LineSize); end; end else // Uncompressed if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3; for Y := 0 to Header.dwHeight-1 do begin aStream.Read(TmpData^, RowSize); Inc(TmpData, LineSize); end; end else raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.'); SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method result := true; except if Assigned(NewImage) then FreeMem(NewImage); raise; end; finally FreeAndNil(Converter); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap.SaveDDS(const aStream: TStream); var Header: TDDSHeader; FormatDesc: TFormatDescriptor; begin if not (ftDDS in FormatGetSupportedFiles(Format)) then raise EglBitmapUnsupportedFormat.Create(Format); FormatDesc := TFormatDescriptor.Get(Format); // Generell FillChar(Header{%H-}, SizeOf(Header), 0); Header.dwSize := SizeOf(Header); Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT; Header.dwWidth := Max(1, Width); Header.dwHeight := Max(1, Height); // Caps Header.Caps.dwCaps1 := DDSCAPS_TEXTURE; // Pixelformat Header.PixelFormat.dwSize := sizeof(Header); if (FormatDesc.IsCompressed) then begin Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC; case Format of tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1; tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3; tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5; end; end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA; Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel; Header.PixelFormat.dwABitMask := FormatDesc.Mask.a; end else if FormatDesc.IsGrayscale then begin Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE; Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel; Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r; Header.PixelFormat.dwABitMask := FormatDesc.Mask.a; end else begin Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB; Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel; Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r; Header.PixelFormat.dwGBitMask := FormatDesc.Mask.g; Header.PixelFormat.dwBBitMask := FormatDesc.Mask.b; Header.PixelFormat.dwABitMask := FormatDesc.Mask.a; end; if (FormatDesc.HasAlpha) then Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS; aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC)); aStream.Write(Header, SizeOf(Header)); aStream.Write(Data^, FormatDesc.GetSize(Dimension)); end; {$IFNDEF OPENGL_ES} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmap1D///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer); var pTemp: pByte; Size: Integer; begin if (aHeight > 1) then begin Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1); GetMem(pTemp, Size); try Move(aData^, pTemp^, Size); FreeMem(aData); aData := nil; except FreeMem(pTemp); raise; end; end else pTemp := aData; inherited SetDataPointer(pTemp, aFormat, aWidth); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap1D.FlipHorz: Boolean; var Col: Integer; pTempDest, pDest, pSource: PByte; begin result := inherited FlipHorz; if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin pSource := Data; GetMem(pDest, fRowSize); try pTempDest := pDest; Inc(pTempDest, fRowSize); for Col := 0 to Width-1 do begin dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data Move(pSource^, pTempDest^, fPixelSize); Inc(pSource, fPixelSize); end; SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method result := true; except if Assigned(pDest) then FreeMem(pDest); raise; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean); var FormatDesc: TFormatDescriptor; begin // Upload data FormatDesc := TFormatDescriptor.Get(Format); if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data'); if FormatDesc.IsCompressed then begin if not Assigned(glCompressedTexImage1D) then raise EglBitmap.Create('compressed formats not supported by video adapter'); glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data) end else if aBuildWithGlu then gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data) else glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data); // Free Data if (FreeDataAfterGenTexture) then FreeData; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean); var BuildWithGlu, TexRec: Boolean; TexSize: Integer; begin if Assigned(Data) then begin // Check Texture Size if (aTestTextureSize) then begin glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize); if (Width > TexSize) then raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.'); TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE); if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.'); end; CreateId; SetupParameters(BuildWithGlu); UploadData(BuildWithGlu); glAreTexturesResident(1, @fID, @fIsResident); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap1D.AfterConstruction; begin inherited; Target := GL_TEXTURE_1D; end; {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmap2D///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer; begin if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then result := fLines[aIndex] else result := nil; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer); var Idx, LineWidth: Integer; begin inherited SetDataPointer(aData, aFormat, aWidth, aHeight); if not TFormatDescriptor.Get(aFormat).IsCompressed then begin // Assigning Data if Assigned(Data) then begin SetLength(fLines, GetHeight); LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel); for Idx := 0 to GetHeight-1 do begin fLines[Idx] := Data; Inc(fLines[Idx], Idx * LineWidth); end; end else SetLength(fLines, 0); end else begin SetLength(fLines, 0); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF}); var FormatDesc: TFormatDescriptor; begin FormatDesc := TFormatDescriptor.Get(Format); if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data'); glPixelStorei(GL_UNPACK_ALIGNMENT, 1); if FormatDesc.IsCompressed then begin if not Assigned(glCompressedTexImage2D) then raise EglBitmap.Create('compressed formats not supported by video adapter'); glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data) {$IFNDEF OPENGL_ES} end else if aBuildWithGlu then begin gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height, FormatDesc.glFormat, FormatDesc.glDataFormat, Data) {$ENDIF} end else begin glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data); end; // Freigeben if (FreeDataAfterGenTexture) then FreeData; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.AfterConstruction; begin inherited; Target := GL_TEXTURE_2D; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat); var Temp: pByte; Size, w, h: Integer; FormatDesc: TFormatDescriptor; begin FormatDesc := TFormatDescriptor.Get(aFormat); if FormatDesc.IsCompressed then raise EglBitmapUnsupportedFormat.Create(aFormat); w := aRight - aLeft; h := aBottom - aTop; Size := FormatDesc.GetSize(w, h); GetMem(Temp, Size); try glPixelStorei(GL_PACK_ALIGNMENT, 1); glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp); SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method FlipVert; except if Assigned(Temp) then FreeMem(Temp); raise; end; end; {$IFNDEF OPENGL_ES} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.GetDataFromTexture; var Temp: PByte; TempWidth, TempHeight: Integer; TempIntFormat: GLint; IntFormat: TglBitmapFormat; FormatDesc: TFormatDescriptor; begin Bind; // Request Data glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth); glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight); glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat); FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor); IntFormat := FormatDesc.Format; // Getting data from OpenGL FormatDesc := TFormatDescriptor.Get(IntFormat); GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight)); try if FormatDesc.IsCompressed then begin if not Assigned(glGetCompressedTexImage) then raise EglBitmap.Create('compressed formats not supported by video adapter'); glGetCompressedTexImage(Target, 0, Temp) end else glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp); SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method except if Assigned(Temp) then FreeMem(Temp); raise; end; end; {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean); var {$IFNDEF OPENGL_ES} BuildWithGlu, TexRec: Boolean; {$ENDIF} PotTex: Boolean; TexSize: Integer; begin if Assigned(Data) then begin // Check Texture Size if (aTestTextureSize) then begin glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize); if ((Height > TexSize) or (Width > TexSize)) then raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.'); PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width); {$IF NOT DEFINED(OPENGL_ES)} TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE); if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.'); {$ELSEIF DEFINED(OPENGL_ES_EXT)} if not PotTex and not GL_OES_texture_npot then raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.'); {$ELSE} if not PotTex then raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.'); {$IFEND} end; CreateId; SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF}); UploadData(Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF}); {$IFNDEF OPENGL_ES} glAreTexturesResident(1, @fID, @fIsResident); {$ENDIF} end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap2D.FlipHorz: Boolean; var Col, Row: Integer; TempDestData, DestData, SourceData: PByte; ImgSize: Integer; begin result := inherited FlipHorz; if Assigned(Data) then begin SourceData := Data; ImgSize := Height * fRowSize; GetMem(DestData, ImgSize); try TempDestData := DestData; Dec(TempDestData, fRowSize + fPixelSize); for Row := 0 to Height -1 do begin Inc(TempDestData, fRowSize * 2); for Col := 0 to Width -1 do begin Move(SourceData^, TempDestData^, fPixelSize); Inc(SourceData, fPixelSize); Dec(TempDestData, fPixelSize); end; end; SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method result := true; except if Assigned(DestData) then FreeMem(DestData); raise; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap2D.FlipVert: Boolean; var Row: Integer; TempDestData, DestData, SourceData: PByte; begin result := inherited FlipVert; if Assigned(Data) then begin SourceData := Data; GetMem(DestData, Height * fRowSize); try TempDestData := DestData; Inc(TempDestData, Width * (Height -1) * fPixelSize); for Row := 0 to Height -1 do begin Move(SourceData^, TempDestData^, fRowSize); Dec(TempDestData, fRowSize); Inc(SourceData, fRowSize); end; SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method result := true; except if Assigned(DestData) then FreeMem(DestData); raise; end; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmap2D - ToNormalMap/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// type TMatrixItem = record X, Y: Integer; W: Single; end; PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec; TglBitmapToNormalMapRec = Record Scale: Single; Heights: array of Single; MatrixU : array of TMatrixItem; MatrixV : array of TMatrixItem; end; const ONE_OVER_255 = 1 / 255; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec); var Val: Single; begin with FuncRec do begin Val := Source.Data.r * LUMINANCE_WEIGHT_R + Source.Data.g * LUMINANCE_WEIGHT_G + Source.Data.b * LUMINANCE_WEIGHT_B; PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255; end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec); begin with FuncRec do PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec); type TVec = Array[0..2] of Single; var Idx: Integer; du, dv: Double; Len: Single; Vec: TVec; function GetHeight(X, Y: Integer): Single; begin with FuncRec do begin X := Max(0, Min(Size.X -1, X)); Y := Max(0, Min(Size.Y -1, Y)); result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X]; end; end; begin with FuncRec do begin with PglBitmapToNormalMapRec(Args)^ do begin du := 0; for Idx := Low(MatrixU) to High(MatrixU) do du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W; dv := 0; for Idx := Low(MatrixU) to High(MatrixU) do dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W; Vec[0] := -du * Scale; Vec[1] := -dv * Scale; Vec[2] := 1; end; // Normalize Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2])); if Len <> 0 then begin Vec[0] := Vec[0] * Len; Vec[1] := Vec[1] * Len; Vec[2] := Vec[2] * Len; end; // Farbe zuweisem Dest.Data.r := Trunc((Vec[0] + 1) * 127.5); Dest.Data.g := Trunc((Vec[1] + 1) * 127.5); Dest.Data.b := Trunc((Vec[2] + 1) * 127.5); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmap2D.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean); var Rec: TglBitmapToNormalMapRec; procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single); begin if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin Matrix[Index].X := X; Matrix[Index].Y := Y; Matrix[Index].W := W; end; end; begin if TFormatDescriptor.Get(Format).IsCompressed then raise EglBitmapUnsupportedFormat.Create(Format); if aScale > 100 then Rec.Scale := 100 else if aScale < -100 then Rec.Scale := -100 else Rec.Scale := aScale; SetLength(Rec.Heights, Width * Height); try case aFunc of nm4Samples: begin SetLength(Rec.MatrixU, 2); SetEntry(Rec.MatrixU, 0, -1, 0, -0.5); SetEntry(Rec.MatrixU, 1, 1, 0, 0.5); SetLength(Rec.MatrixV, 2); SetEntry(Rec.MatrixV, 0, 0, 1, 0.5); SetEntry(Rec.MatrixV, 1, 0, -1, -0.5); end; nmSobel: begin SetLength(Rec.MatrixU, 6); SetEntry(Rec.MatrixU, 0, -1, 1, -1.0); SetEntry(Rec.MatrixU, 1, -1, 0, -2.0); SetEntry(Rec.MatrixU, 2, -1, -1, -1.0); SetEntry(Rec.MatrixU, 3, 1, 1, 1.0); SetEntry(Rec.MatrixU, 4, 1, 0, 2.0); SetEntry(Rec.MatrixU, 5, 1, -1, 1.0); SetLength(Rec.MatrixV, 6); SetEntry(Rec.MatrixV, 0, -1, 1, 1.0); SetEntry(Rec.MatrixV, 1, 0, 1, 2.0); SetEntry(Rec.MatrixV, 2, 1, 1, 1.0); SetEntry(Rec.MatrixV, 3, -1, -1, -1.0); SetEntry(Rec.MatrixV, 4, 0, -1, -2.0); SetEntry(Rec.MatrixV, 5, 1, -1, -1.0); end; nm3x3: begin SetLength(Rec.MatrixU, 6); SetEntry(Rec.MatrixU, 0, -1, 1, -1/6); SetEntry(Rec.MatrixU, 1, -1, 0, -1/6); SetEntry(Rec.MatrixU, 2, -1, -1, -1/6); SetEntry(Rec.MatrixU, 3, 1, 1, 1/6); SetEntry(Rec.MatrixU, 4, 1, 0, 1/6); SetEntry(Rec.MatrixU, 5, 1, -1, 1/6); SetLength(Rec.MatrixV, 6); SetEntry(Rec.MatrixV, 0, -1, 1, 1/6); SetEntry(Rec.MatrixV, 1, 0, 1, 1/6); SetEntry(Rec.MatrixV, 2, 1, 1, 1/6); SetEntry(Rec.MatrixV, 3, -1, -1, -1/6); SetEntry(Rec.MatrixV, 4, 0, -1, -1/6); SetEntry(Rec.MatrixV, 5, 1, -1, -1/6); end; nm5x5: begin SetLength(Rec.MatrixU, 20); SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16); SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10); SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10); SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16); SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10); SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8); SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8); SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10); SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8); SetEntry(Rec.MatrixU, 9, -1, 0, -0.5); SetEntry(Rec.MatrixU, 10, 1, 0, 0.5); SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8); SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10); SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8); SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8); SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10); SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16); SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10); SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10); SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16); SetLength(Rec.MatrixV, 20); SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16); SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10); SetEntry(Rec.MatrixV, 2, 0, 2, 0.25); SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10); SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16); SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10); SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8); SetEntry(Rec.MatrixV, 7, 0, 1, 0.5); SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8); SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16); SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16); SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8); SetEntry(Rec.MatrixV, 12, 0, -1, -0.5); SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8); SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10); SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16); SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10); SetEntry(Rec.MatrixV, 17, 0, -2, -0.25); SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10); SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16); end; end; // Daten Sammeln if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec) else Convert(glBitmapToNormalMapPrepareFunc, false, @Rec); Convert(glBitmapToNormalMapFunc, false, @Rec); finally SetLength(Rec.Heights, 0); end; end; {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmapCubeMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean); begin Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.'); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapCubeMap.AfterConstruction; begin inherited; {$IFNDEF OPENGL_ES} if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.'); {$ELSE} if not (GL_VERSION_2_0) then raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.'); {$ENDIF} SetWrap; Target := GL_TEXTURE_CUBE_MAP; {$IFNDEF OPENGL_ES} fGenMode := GL_REFLECTION_MAP; {$ENDIF} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean); var {$IFNDEF OPENGL_ES} BuildWithGlu: Boolean; {$ENDIF} TexSize: Integer; begin if (aTestTextureSize) then begin glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize); if (Height > TexSize) or (Width > TexSize) then raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.'); {$IF NOT DEFINED(OPENGL_ES)} if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.'); {$ELSEIF DEFINED(OPENGL_ES_EXT)} if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) and not GL_OES_texture_npot then raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.'); {$ELSE} if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) then raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.'); {$IFEND} end; if (ID = 0) then CreateID; SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF}); UploadData(aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF}); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean); begin inherited Bind (aEnableTextureUnit); {$IFNDEF OPENGL_ES} if aEnableTexCoordsGen then begin glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode); glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode); glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode); glEnable(GL_TEXTURE_GEN_S); glEnable(GL_TEXTURE_GEN_T); glEnable(GL_TEXTURE_GEN_R); end; {$ENDIF} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean); begin inherited Unbind(aDisableTextureUnit); {$IFNDEF OPENGL_ES} if aDisableTexCoordsGen then begin glDisable(GL_TEXTURE_GEN_S); glDisable(GL_TEXTURE_GEN_T); glDisable(GL_TEXTURE_GEN_R); end; {$ENDIF} end; {$IFEND} {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglBitmapNormalMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// type TVec = Array[0..2] of Single; TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer); PglBitmapNormalMapRec = ^TglBitmapNormalMapRec; TglBitmapNormalMapRec = record HalfSize : Integer; Func: TglBitmapNormalMapGetVectorFunc; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer); begin aVec[0] := aHalfSize; aVec[1] := - (aPosition.Y + 0.5 - aHalfSize); aVec[2] := - (aPosition.X + 0.5 - aHalfSize); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer); begin aVec[0] := - aHalfSize; aVec[1] := - (aPosition.Y + 0.5 - aHalfSize); aVec[2] := aPosition.X + 0.5 - aHalfSize; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer); begin aVec[0] := aPosition.X + 0.5 - aHalfSize; aVec[1] := aHalfSize; aVec[2] := aPosition.Y + 0.5 - aHalfSize; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer); begin aVec[0] := aPosition.X + 0.5 - aHalfSize; aVec[1] := - aHalfSize; aVec[2] := - (aPosition.Y + 0.5 - aHalfSize); end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer); begin aVec[0] := aPosition.X + 0.5 - aHalfSize; aVec[1] := - (aPosition.Y + 0.5 - aHalfSize); aVec[2] := aHalfSize; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer); begin aVec[0] := - (aPosition.X + 0.5 - aHalfSize); aVec[1] := - (aPosition.Y + 0.5 - aHalfSize); aVec[2] := - aHalfSize; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec); var i: Integer; Vec: TVec; Len: Single; begin with FuncRec do begin with PglBitmapNormalMapRec(Args)^ do begin Func(Vec, Position, HalfSize); // Normalize Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2])); if Len <> 0 then begin Vec[0] := Vec[0] * Len; Vec[1] := Vec[1] * Len; Vec[2] := Vec[2] * Len; end; // Scale Vector and AddVectro Vec[0] := Vec[0] * 0.5 + 0.5; Vec[1] := Vec[1] * 0.5 + 0.5; Vec[2] := Vec[2] * 0.5 + 0.5; end; // Set Color for i := 0 to 2 do Dest.Data.arr[i] := Round(Vec[i] * 255); end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapNormalMap.AfterConstruction; begin inherited; {$IFNDEF OPENGL_ES} fGenMode := GL_NORMAL_MAP; {$ENDIF} end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean); var Rec: TglBitmapNormalMapRec; SizeRec: TglBitmapSize; begin Rec.HalfSize := aSize div 2; FreeDataAfterGenTexture := false; SizeRec.Fields := [ffX, ffY]; SizeRec.X := aSize; SizeRec.Y := aSize; // Positive X Rec.Func := glBitmapNormalMapPosX; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize); // Negative X Rec.Func := glBitmapNormalMapNegX; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize); // Positive Y Rec.Func := glBitmapNormalMapPosY; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize); // Negative Y Rec.Func := glBitmapNormalMapNegY; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize); // Positive Z Rec.Func := glBitmapNormalMapPosZ; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize); // Negative Z Rec.Func := glBitmapNormalMapNegZ; LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec); GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize); end; {$IFEND} initialization glBitmapSetDefaultFormat (tfEmpty); glBitmapSetDefaultMipmap (mmMipmap); glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR); glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE); {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)} glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA); {$IFEND} glBitmapSetDefaultFreeDataAfterGenTexture(true); glBitmapSetDefaultDeleteTextureOnFree (true); TFormatDescriptor.Init; finalization TFormatDescriptor.Finalize; end.