您最多选择25个主题 主题必须以字母或数字开头,可以包含连字符 (-),并且长度不得超过35个字符

8902 行
319 KiB

  1. { glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  2. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  3. modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
  4. The contents of this file are used with permission, subject to
  5. the Mozilla Public License Version 1.1 (the "License"); you may
  6. not use this file except in compliance with the License. You may
  7. obtain a copy of the License at
  8. http://www.mozilla.org/MPL/MPL-1.1.html
  9. The glBitmap is a Delphi/FPC unit that contains several wrapper classes
  10. to manage OpenGL texture objects. Below you can find a list of the main
  11. functionality of this classes:
  12. - load texture data from file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  13. - load texture data from several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  14. - save texture data to file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  15. - save texture data to several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  16. - support for many texture formats (e.g. RGB8, BGR8, RGBA8, BGRA8, ...)
  17. - manage texture properties (e.g. Filter, Clamp, Mipmap, ...)
  18. - upload texture data to video card
  19. - download texture data from video card
  20. - manipulate texture data (e.g. add alpha, remove alpha, convert to other format, switch RGB, ...) }
  21. unit glBitmap;
  22. {$I glBitmapConf.inc}
  23. // Delphi Versions
  24. {$IFDEF fpc}
  25. {$MODE Delphi}
  26. {$IFDEF CPUI386}
  27. {$DEFINE CPU386}
  28. {$ASMMODE INTEL}
  29. {$ENDIF}
  30. {$IFNDEF WINDOWS}
  31. {$linklib c}
  32. {$ENDIF}
  33. {$ENDIF}
  34. // Operation System
  35. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  36. {$DEFINE GLB_WIN}
  37. {$ELSEIF DEFINED(LINUX)}
  38. {$DEFINE GLB_LINUX}
  39. {$IFEND}
  40. // OpenGL ES
  41. {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  42. {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}
  43. {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  44. {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES} {$IFEND}
  45. // checking define combinations
  46. //SDL Image
  47. {$IFDEF GLB_SDL_IMAGE}
  48. {$IFNDEF GLB_SDL}
  49. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  50. {$DEFINE GLB_SDL}
  51. {$ENDIF}
  52. {$IFDEF GLB_LAZ_PNG}
  53. {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  54. {$undef GLB_LAZ_PNG}
  55. {$ENDIF}
  56. {$IFDEF GLB_PNGIMAGE}
  57. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  58. {$undef GLB_PNGIMAGE}
  59. {$ENDIF}
  60. {$IFDEF GLB_LAZ_JPEG}
  61. {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  62. {$undef GLB_LAZ_JPEG}
  63. {$ENDIF}
  64. {$IFDEF GLB_DELPHI_JPEG}
  65. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  66. {$undef GLB_DELPHI_JPEG}
  67. {$ENDIF}
  68. {$IFDEF GLB_LIB_PNG}
  69. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  70. {$undef GLB_LIB_PNG}
  71. {$ENDIF}
  72. {$IFDEF GLB_LIB_JPEG}
  73. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  74. {$undef GLB_LIB_JPEG}
  75. {$ENDIF}
  76. {$DEFINE GLB_SUPPORT_PNG_READ}
  77. {$DEFINE GLB_SUPPORT_JPEG_READ}
  78. {$ENDIF}
  79. // Lazarus TPortableNetworkGraphic
  80. {$IFDEF GLB_LAZ_PNG}
  81. {$IFNDEF GLB_LAZARUS}
  82. {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
  83. {$DEFINE GLB_LAZARUS}
  84. {$ENDIF}
  85. {$IFDEF GLB_PNGIMAGE}
  86. {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  87. {$undef GLB_PNGIMAGE}
  88. {$ENDIF}
  89. {$IFDEF GLB_LIB_PNG}
  90. {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  91. {$undef GLB_LIB_PNG}
  92. {$ENDIF}
  93. {$DEFINE GLB_SUPPORT_PNG_READ}
  94. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  95. {$ENDIF}
  96. // PNG Image
  97. {$IFDEF GLB_PNGIMAGE}
  98. {$IFDEF GLB_LIB_PNG}
  99. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  100. {$undef GLB_LIB_PNG}
  101. {$ENDIF}
  102. {$DEFINE GLB_SUPPORT_PNG_READ}
  103. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  104. {$ENDIF}
  105. // libPNG
  106. {$IFDEF GLB_LIB_PNG}
  107. {$DEFINE GLB_SUPPORT_PNG_READ}
  108. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  109. {$ENDIF}
  110. // Lazarus TJPEGImage
  111. {$IFDEF GLB_LAZ_JPEG}
  112. {$IFNDEF GLB_LAZARUS}
  113. {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
  114. {$DEFINE GLB_LAZARUS}
  115. {$ENDIF}
  116. {$IFDEF GLB_DELPHI_JPEG}
  117. {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
  118. {$undef GLB_DELPHI_JPEG}
  119. {$ENDIF}
  120. {$IFDEF GLB_LIB_JPEG}
  121. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
  122. {$undef GLB_LIB_JPEG}
  123. {$ENDIF}
  124. {$DEFINE GLB_SUPPORT_JPEG_READ}
  125. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  126. {$ENDIF}
  127. // JPEG Image
  128. {$IFDEF GLB_DELPHI_JPEG}
  129. {$IFDEF GLB_LIB_JPEG}
  130. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  131. {$undef GLB_LIB_JPEG}
  132. {$ENDIF}
  133. {$DEFINE GLB_SUPPORT_JPEG_READ}
  134. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  135. {$ENDIF}
  136. // libJPEG
  137. {$IFDEF GLB_LIB_JPEG}
  138. {$DEFINE GLB_SUPPORT_JPEG_READ}
  139. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  140. {$ENDIF}
  141. // general options
  142. {$EXTENDEDSYNTAX ON}
  143. {$LONGSTRINGS ON}
  144. {$ALIGN ON}
  145. {$IFNDEF FPC}
  146. {$OPTIMIZATION ON}
  147. {$ENDIF}
  148. interface
  149. uses
  150. {$IFDEF OPENGL_ES} dglOpenGLES,
  151. {$ELSE} dglOpenGL, {$ENDIF}
  152. {$IF DEFINED(GLB_WIN) AND
  153. DEFINED(GLB_DELPHI)} windows, {$IFEND}
  154. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  155. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  156. {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$ENDIF}
  157. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  158. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  159. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  160. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  161. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  162. Classes, SysUtils;
  163. type
  164. {$IFNDEF fpc}
  165. QWord = System.UInt64;
  166. PQWord = ^QWord;
  167. PtrInt = Longint;
  168. PtrUInt = DWord;
  169. {$ENDIF}
  170. { type that describes the format of the data stored in a texture.
  171. the name of formats is composed of the following constituents:
  172. - multiple channels:
  173. - channel (e.g. R, G, B, A or Alpha, Luminance or X (reserved))
  174. - width of the chanel in bit (4, 8, 16, ...)
  175. - data type (e.g. ub, us, ui)
  176. - number of elements of data types }
  177. TglBitmapFormat = (
  178. tfEmpty = 0,
  179. tfAlpha4ub1, //< 1 x unsigned byte
  180. tfAlpha8ub1, //< 1 x unsigned byte
  181. tfAlpha16us1, //< 1 x unsigned short
  182. tfLuminance4ub1, //< 1 x unsigned byte
  183. tfLuminance8ub1, //< 1 x unsigned byte
  184. tfLuminance16us1, //< 1 x unsigned short
  185. tfLuminance4Alpha4ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  186. tfLuminance6Alpha2ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  187. tfLuminance8Alpha8ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  188. tfLuminance12Alpha4us2, //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
  189. tfLuminance16Alpha16us2, //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
  190. tfR3G3B2ub1, //< 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
  191. tfRGBX4us1, //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
  192. tfXRGB4us1, //< 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
  193. tfR5G6B5us1, //< 1 x unsigned short (5bit red, 6bit green, 5bit blue)
  194. tfRGB5X1us1, //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
  195. tfX1RGB5us1, //< 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
  196. tfRGB8ub3, //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
  197. tfRGBX8ui1, //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
  198. tfXRGB8ui1, //< 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
  199. tfRGB10X2ui1, //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
  200. tfX2RGB10ui1, //< 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
  201. tfRGB16us3, //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
  202. tfRGBA4us1, //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
  203. tfARGB4us1, //< 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
  204. tfRGB5A1us1, //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
  205. tfA1RGB5us1, //< 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
  206. tfRGBA8ui1, //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
  207. tfARGB8ui1, //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
  208. tfRGBA8ub4, //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
  209. tfRGB10A2ui1, //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
  210. tfA2RGB10ui1, //< 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
  211. tfRGBA16us4, //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
  212. tfBGRX4us1, //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
  213. tfXBGR4us1, //< 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
  214. tfB5G6R5us1, //< 1 x unsigned short (5bit blue, 6bit green, 5bit red)
  215. tfBGR5X1us1, //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
  216. tfX1BGR5us1, //< 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
  217. tfBGR8ub3, //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
  218. tfBGRX8ui1, //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
  219. tfXBGR8ui1, //< 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
  220. tfBGR10X2ui1, //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
  221. tfX2BGR10ui1, //< 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
  222. tfBGR16us3, //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
  223. tfBGRA4us1, //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
  224. tfABGR4us1, //< 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
  225. tfBGR5A1us1, //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
  226. tfA1BGR5us1, //< 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
  227. tfBGRA8ui1, //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
  228. tfABGR8ui1, //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
  229. tfBGRA8ub4, //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
  230. tfBGR10A2ui1, //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
  231. tfA2BGR10ui1, //< 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
  232. tfBGRA16us4, //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
  233. tfDepth16us1, //< 1 x unsigned short (depth)
  234. tfDepth24ui1, //< 1 x unsigned int (depth)
  235. tfDepth32ui1, //< 1 x unsigned int (depth)
  236. tfS3tcDtx1RGBA,
  237. tfS3tcDtx3RGBA,
  238. tfS3tcDtx5RGBA
  239. );
  240. { type to define suitable file formats }
  241. TglBitmapFileType = (
  242. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF} //< Portable Network Graphic file (PNG)
  243. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF} //< JPEG file
  244. ftDDS, //< Direct Draw Surface file (DDS)
  245. ftTGA, //< Targa Image File (TGA)
  246. ftBMP, //< Windows Bitmap File (BMP)
  247. ftRAW); //< glBitmap RAW file format
  248. TglBitmapFileTypes = set of TglBitmapFileType;
  249. { possible mipmap types }
  250. TglBitmapMipMap = (
  251. mmNone, //< no mipmaps
  252. mmMipmap, //< normal mipmaps
  253. mmMipmapGlu); //< mipmaps generated with glu functions
  254. { possible normal map functions }
  255. TglBitmapNormalMapFunc = (
  256. nm4Samples,
  257. nmSobel,
  258. nm3x3,
  259. nm5x5);
  260. ////////////////////////////////////////////////////////////////////////////////////////////////////
  261. EglBitmap = class(Exception); //< glBitmap exception
  262. EglBitmapNotSupported = class(Exception); //< exception for not supported functions
  263. EglBitmapSizeToLarge = class(EglBitmap); //< exception for to large textures
  264. EglBitmapNonPowerOfTwo = class(EglBitmap); //< exception for non power of two textures
  265. EglBitmapUnsupportedFormat = class(EglBitmap) //< exception for unsupporetd formats
  266. public
  267. constructor Create(const aFormat: TglBitmapFormat); overload;
  268. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  269. end;
  270. ////////////////////////////////////////////////////////////////////////////////////////////////////
  271. { record that stores 4 unsigned integer values }
  272. TglBitmapRec4ui = packed record
  273. case Integer of
  274. 0: (r, g, b, a: Cardinal);
  275. 1: (arr: array[0..3] of Cardinal);
  276. end;
  277. { record that stores 4 unsigned byte values }
  278. TglBitmapRec4ub = packed record
  279. case Integer of
  280. 0: (r, g, b, a: Byte);
  281. 1: (arr: array[0..3] of Byte);
  282. end;
  283. { record that stores 4 unsigned long integer values }
  284. TglBitmapRec4ul = packed record
  285. case Integer of
  286. 0: (r, g, b, a: QWord);
  287. 1: (arr: array[0..3] of QWord);
  288. end;
  289. { describes the properties of a given texture data format }
  290. TglBitmapFormatDescriptor = class(TObject)
  291. private
  292. // cached properties
  293. fBytesPerPixel: Single; //< number of bytes for each pixel
  294. fChannelCount: Integer; //< number of color channels
  295. fMask: TglBitmapRec4ul; //< bitmask for each color channel
  296. fRange: TglBitmapRec4ui; //< maximal value of each color channel
  297. { @return @true if the format has a red color channel, @false otherwise }
  298. function GetHasRed: Boolean;
  299. { @return @true if the format has a green color channel, @false otherwise }
  300. function GetHasGreen: Boolean;
  301. { @return @true if the format has a blue color channel, @false otherwise }
  302. function GetHasBlue: Boolean;
  303. { @return @true if the format has a alpha color channel, @false otherwise }
  304. function GetHasAlpha: Boolean;
  305. { @return @true if the format has any color color channel, @false otherwise }
  306. function GetHasColor: Boolean;
  307. { @return @true if the format is a grayscale format, @false otherwise }
  308. function GetIsGrayscale: Boolean;
  309. protected
  310. fFormat: TglBitmapFormat; //< format this descriptor belongs to
  311. fWithAlpha: TglBitmapFormat; //< suitable format with alpha channel
  312. fWithoutAlpha: TglBitmapFormat; //< suitable format without alpha channel
  313. fOpenGLFormat: TglBitmapFormat; //< suitable format that is supported by OpenGL
  314. fRGBInverted: TglBitmapFormat; //< suitable format with inverted RGB channels
  315. fUncompressed: TglBitmapFormat; //< suitable format with uncompressed data
  316. fBitsPerPixel: Integer; //< number of bits per pixel
  317. fIsCompressed: Boolean; //< @true if the format is compressed, @false otherwise
  318. fPrecision: TglBitmapRec4ub; //< number of bits for each color channel
  319. fShift: TglBitmapRec4ub; //< bit offset for each color channel
  320. fglFormat: GLenum; //< OpenGL format enum (e.g. GL_RGB)
  321. fglInternalFormat: GLenum; //< OpenGL internal format enum (e.g. GL_RGB8)
  322. fglDataFormat: GLenum; //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
  323. { set values for this format descriptor }
  324. procedure SetValues; virtual;
  325. { calculate cached values }
  326. procedure CalcValues;
  327. public
  328. property Format: TglBitmapFormat read fFormat; //< format this descriptor belongs to
  329. property ChannelCount: Integer read fChannelCount; //< number of color channels
  330. property IsCompressed: Boolean read fIsCompressed; //< @true if the format is compressed, @false otherwise
  331. property BitsPerPixel: Integer read fBitsPerPixel; //< number of bytes per pixel
  332. property BytesPerPixel: Single read fBytesPerPixel; //< number of bits per pixel
  333. property Precision: TglBitmapRec4ub read fPrecision; //< number of bits for each color channel
  334. property Shift: TglBitmapRec4ub read fShift; //< bit offset for each color channel
  335. property Range: TglBitmapRec4ui read fRange; //< maximal value of each color channel
  336. property Mask: TglBitmapRec4ul read fMask; //< bitmask for each color channel
  337. property RGBInverted: TglBitmapFormat read fRGBInverted; //< suitable format with inverted RGB channels
  338. property WithAlpha: TglBitmapFormat read fWithAlpha; //< suitable format with alpha channel
  339. property WithoutAlpha: TglBitmapFormat read fWithAlpha; //< suitable format without alpha channel
  340. property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL
  341. property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data
  342. property glFormat: GLenum read fglFormat; //< OpenGL format enum (e.g. GL_RGB)
  343. property glInternalFormat: GLenum read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8)
  344. property glDataFormat: GLenum read fglDataFormat; //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
  345. property HasRed: Boolean read GetHasRed; //< @true if the format has a red color channel, @false otherwise
  346. property HasGreen: Boolean read GetHasGreen; //< @true if the format has a green color channel, @false otherwise
  347. property HasBlue: Boolean read GetHasBlue; //< @true if the format has a blue color channel, @false otherwise
  348. property HasAlpha: Boolean read GetHasAlpha; //< @true if the format has a alpha color channel, @false otherwise
  349. property HasColor: Boolean read GetHasColor; //< @true if the format has any color color channel, @false otherwise
  350. property IsGrayscale: Boolean read GetIsGrayscale; //< @true if the format is a grayscale format, @false otherwise
  351. { constructor }
  352. constructor Create;
  353. public
  354. { get the format descriptor by a given OpenGL internal format
  355. @param aInternalFormat OpenGL internal format to get format descriptor for
  356. @returns suitable format descriptor or tfEmpty-Descriptor }
  357. class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  358. end;
  359. ////////////////////////////////////////////////////////////////////////////////////////////////////
  360. { structure to store pixel data in }
  361. TglBitmapPixelData = packed record
  362. Data: TglBitmapRec4ui; //< color data for each color channel
  363. Range: TglBitmapRec4ui; //< maximal color value for each channel
  364. Format: TglBitmapFormat; //< format of the pixel
  365. end;
  366. PglBitmapPixelData = ^TglBitmapPixelData;
  367. TglBitmapSizeFields = set of (ffX, ffY);
  368. TglBitmapSize = packed record
  369. Fields: TglBitmapSizeFields;
  370. X: Word;
  371. Y: Word;
  372. end;
  373. TglBitmapPixelPosition = TglBitmapSize;
  374. ////////////////////////////////////////////////////////////////////////////////////////////////////
  375. TglBitmap = class;
  376. { structure to store data for converting in }
  377. TglBitmapFunctionRec = record
  378. Sender: TglBitmap; //< texture object that stores the data to convert
  379. Size: TglBitmapSize; //< size of the texture
  380. Position: TglBitmapPixelPosition; //< position of the currently pixel
  381. Source: TglBitmapPixelData; //< pixel data of the current pixel
  382. Dest: TglBitmapPixelData; //< new data of the pixel (must be filled in)
  383. Args: Pointer; //< user defined args that was passed to the convert function
  384. end;
  385. { callback to use for converting texture data }
  386. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  387. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  388. { base class for all glBitmap classes. used to manage OpenGL texture objects
  389. and to load, save and manipulate texture data }
  390. TglBitmap = class
  391. private
  392. { @returns format descriptor that describes the format of the stored data }
  393. function GetFormatDesc: TglBitmapFormatDescriptor;
  394. protected
  395. fID: GLuint; //< name of the OpenGL texture object
  396. fTarget: GLuint; //< texture target (e.g. GL_TEXTURE_2D)
  397. fAnisotropic: Integer; //< anisotropic level
  398. fDeleteTextureOnFree: Boolean; //< delete OpenGL texture object when this object is destroyed
  399. fFreeDataOnDestroy: Boolean; //< free stored data when this object is destroyed
  400. fFreeDataAfterGenTexture: Boolean; //< free stored data after data was uploaded to video card
  401. fData: PByte; //< data of this texture
  402. {$IFNDEF OPENGL_ES}
  403. fIsResident: GLboolean; //< @true if OpenGL texture object has data, @false otherwise
  404. {$ENDIF}
  405. fBorderColor: array[0..3] of Single; //< color of the texture border
  406. fDimension: TglBitmapSize; //< size of this texture
  407. fMipMap: TglBitmapMipMap; //< mipmap type
  408. fFormat: TglBitmapFormat; //< format the texture data is stored in
  409. // Mapping
  410. fPixelSize: Integer; //< size of one pixel (in byte)
  411. fRowSize: Integer; //< size of one pixel row (in byte)
  412. // Filtering
  413. fFilterMin: GLenum; //< min filter to apply to the texture
  414. fFilterMag: GLenum; //< mag filter to apply to the texture
  415. // TexturWarp
  416. fWrapS: GLenum; //< texture wrapping for x axis
  417. fWrapT: GLenum; //< texture wrapping for y axis
  418. fWrapR: GLenum; //< texture wrapping for z axis
  419. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  420. //Swizzle
  421. fSwizzle: array[0..3] of GLenum; //< color channel swizzle
  422. {$IFEND}
  423. // CustomData
  424. fFilename: String; //< filename the texture was load from
  425. fCustomName: String; //< user defined name
  426. fCustomNameW: WideString; //< user defined name
  427. fCustomData: Pointer; //< user defined data
  428. protected
  429. { @returns the actual width of the texture }
  430. function GetWidth: Integer; virtual;
  431. { @returns the actual height of the texture }
  432. function GetHeight: Integer; virtual;
  433. { @returns the width of the texture or 1 if the width is zero }
  434. function GetFileWidth: Integer; virtual;
  435. { @returns the height of the texture or 1 if the height is zero }
  436. function GetFileHeight: Integer; virtual;
  437. protected
  438. { set a new value for fCustomData }
  439. procedure SetCustomData(const aValue: Pointer);
  440. { set a new value for fCustomName }
  441. procedure SetCustomName(const aValue: String);
  442. { set a new value for fCustomNameW }
  443. procedure SetCustomNameW(const aValue: WideString);
  444. { set new value for fFreeDataOnDestroy }
  445. procedure SetFreeDataOnDestroy(const aValue: Boolean);
  446. { set new value for fDeleteTextureOnFree }
  447. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  448. { set new value for the data format. only possible if new format has the same pixel size.
  449. if you want to convert the texture data, see ConvertTo function }
  450. procedure SetFormat(const aValue: TglBitmapFormat);
  451. { set new value for fFreeDataAfterGenTexture }
  452. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  453. { set name of OpenGL texture object }
  454. procedure SetID(const aValue: Cardinal);
  455. { set new value for fMipMap }
  456. procedure SetMipMap(const aValue: TglBitmapMipMap);
  457. { set new value for target }
  458. procedure SetTarget(const aValue: Cardinal);
  459. { set new value for fAnisotrophic }
  460. procedure SetAnisotropic(const aValue: Integer);
  461. protected
  462. { create OpenGL texture object (delete exisiting object if exists) }
  463. procedure CreateID;
  464. { setup texture parameters }
  465. procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  466. { set data pointer of texture data
  467. @param aData pointer to new texture data (be carefull, aData could be freed by this function)
  468. @param aFormat format of the data stored at aData
  469. @param aWidth width of the texture data
  470. @param aHeight height of the texture data }
  471. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  472. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
  473. { generate texture (upload texture data to video card)
  474. @param aTestTextureSize test texture size before uploading and raise exception if something is wrong }
  475. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  476. { flip texture horizontal
  477. @returns @true in success, @false otherwise }
  478. function FlipHorz: Boolean; virtual;
  479. { flip texture vertical
  480. @returns @true in success, @false otherwise }
  481. function FlipVert: Boolean; virtual;
  482. protected
  483. property Width: Integer read GetWidth; //< the actual width of the texture
  484. property Height: Integer read GetHeight; //< the actual height of the texture
  485. property FileWidth: Integer read GetFileWidth; //< the width of the texture or 1 if the width is zero
  486. property FileHeight: Integer read GetFileHeight; //< the height of the texture or 1 if the height is zero
  487. public
  488. property ID: Cardinal read fID write SetID; //< name of the OpenGL texture object
  489. property Target: Cardinal read fTarget write SetTarget; //< texture target (e.g. GL_TEXTURE_2D)
  490. property Format: TglBitmapFormat read fFormat write SetFormat; //< format the texture data is stored in
  491. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap; //< mipmap type
  492. property Anisotropic: Integer read fAnisotropic write SetAnisotropic; //< anisotropic level
  493. property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc; //< format descriptor that describes the format of the stored data
  494. property Filename: String read fFilename; //< filename the texture was load from
  495. property CustomName: String read fCustomName write SetCustomName; //< user defined name (use at will)
  496. property CustomNameW: WideString read fCustomNameW write SetCustomNameW; //< user defined name (as WideString; use at will)
  497. property CustomData: Pointer read fCustomData write SetCustomData; //< user defined data (use at will)
  498. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree; //< delete texture object when this object is destroyed
  499. property FreeDataOnDestroy: Boolean read fFreeDataOnDestroy write SetFreeDataOnDestroy; //< free stored data when this object is destroyed
  500. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture; //< free stored data after it is uplaoded to video card
  501. property Dimension: TglBitmapSize read fDimension; //< size of the texture
  502. property Data: PByte read fData; //< texture data (or @nil if unset)
  503. {$IFNDEF OPENGL_ES}
  504. property IsResident: GLboolean read fIsResident; //< @true if OpenGL texture object has data, @false otherwise
  505. {$ENDIF}
  506. { this method is called after the constructor and sets the default values of this object }
  507. procedure AfterConstruction; override;
  508. { this method is called before the destructor and does some cleanup }
  509. procedure BeforeDestruction; override;
  510. { splits a resource identifier into the resource and it's type
  511. @param aResource resource identifier to split and store name in
  512. @param aResType type of the resource }
  513. procedure PrepareResType(var aResource: String; var aResType: PChar);
  514. public
  515. { load a texture from a file
  516. @param aFilename file to load texuture from }
  517. procedure LoadFromFile(const aFilename: String);
  518. { load a texture from a stream
  519. @param aStream stream to load texture from }
  520. procedure LoadFromStream(const aStream: TStream); virtual;
  521. { use a function to generate texture data
  522. @param aSize size of the texture
  523. @param aFunc callback to use for generation
  524. @param aFormat format of the texture data
  525. @param aArgs user defined paramaters (use at will) }
  526. procedure LoadFromFunc(const aSize: TglBitmapSize; const aFunc: TglBitmapFunction;
  527. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  528. { load a texture from a resource
  529. @param aInstance resource handle
  530. @param aResource resource indentifier
  531. @param aResType resource type (if known) }
  532. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  533. { load a texture from a resource id
  534. @param aInstance resource handle
  535. @param aResource resource ID
  536. @param aResType resource type }
  537. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  538. public
  539. { save texture data to a file
  540. @param aFilename filename to store texture in
  541. @param aFileType file type to store data into }
  542. procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
  543. { save texture data to a stream
  544. @param aFilename filename to store texture in
  545. @param aFileType file type to store data into }
  546. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  547. public
  548. { convert texture data using a user defined callback
  549. @param aFunc callback to use for converting
  550. @param aCreateTemp create a temporary buffer to use for converting
  551. @param aArgs user defined paramters (use at will)
  552. @returns @true if converting was successful, @false otherwise }
  553. function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  554. { convert texture data using a user defined callback
  555. @param aSource glBitmap to read data from
  556. @param aFunc callback to use for converting
  557. @param aCreateTemp create a temporary buffer to use for converting
  558. @param aFormat format of the new data
  559. @param aArgs user defined paramters (use at will)
  560. @returns @true if converting was successful, @false otherwise }
  561. function Convert(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  562. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  563. { convert texture data using a specific format
  564. @param aFormat new format of texture data
  565. @returns @true if converting was successful, @false otherwise }
  566. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  567. {$IFDEF GLB_SDL}
  568. public
  569. { assign texture data to SDL surface
  570. @param aSurface SDL surface to write data to
  571. @returns @true on success, @false otherwise }
  572. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  573. { assign texture data from SDL surface
  574. @param aSurface SDL surface to read data from
  575. @returns @true on success, @false otherwise }
  576. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  577. { assign alpha channel data to SDL surface
  578. @param aSurface SDL surface to write alpha channel data to
  579. @returns @true on success, @false otherwise }
  580. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  581. { assign alpha channel data from SDL surface
  582. @param aSurface SDL surface to read data from
  583. @param aFunc callback to use for converting
  584. @param aArgs user defined parameters (use at will)
  585. @returns @true on success, @false otherwise }
  586. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  587. {$ENDIF}
  588. {$IFDEF GLB_DELPHI}
  589. public
  590. { assign texture data to TBitmap object
  591. @param aBitmap TBitmap to write data to
  592. @returns @true on success, @false otherwise }
  593. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  594. { assign texture data from TBitmap object
  595. @param aBitmap TBitmap to read data from
  596. @returns @true on success, @false otherwise }
  597. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  598. { assign alpha channel data to TBitmap object
  599. @param aBitmap TBitmap to write data to
  600. @returns @true on success, @false otherwise }
  601. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  602. { assign alpha channel data from TBitmap object
  603. @param aBitmap TBitmap to read data from
  604. @param aFunc callback to use for converting
  605. @param aArgs user defined parameters (use at will)
  606. @returns @true on success, @false otherwise }
  607. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  608. {$ENDIF}
  609. {$IFDEF GLB_LAZARUS}
  610. public
  611. { assign texture data to TLazIntfImage object
  612. @param aImage TLazIntfImage to write data to
  613. @returns @true on success, @false otherwise }
  614. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  615. { assign texture data from TLazIntfImage object
  616. @param aImage TLazIntfImage to read data from
  617. @returns @true on success, @false otherwise }
  618. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  619. { assign alpha channel data to TLazIntfImage object
  620. @param aImage TLazIntfImage to write data to
  621. @returns @true on success, @false otherwise }
  622. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  623. { assign alpha channel data from TLazIntfImage object
  624. @param aImage TLazIntfImage to read data from
  625. @param aFunc callback to use for converting
  626. @param aArgs user defined parameters (use at will)
  627. @returns @true on success, @false otherwise }
  628. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  629. {$ENDIF}
  630. public
  631. { load alpha channel data from resource
  632. @param aInstance resource handle
  633. @param aResource resource ID
  634. @param aResType resource type
  635. @param aFunc callback to use for converting
  636. @param aArgs user defined parameters (use at will)
  637. @returns @true on success, @false otherwise }
  638. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  639. { load alpha channel data from resource ID
  640. @param aInstance resource handle
  641. @param aResourceID resource ID
  642. @param aResType resource type
  643. @param aFunc callback to use for converting
  644. @param aArgs user defined parameters (use at will)
  645. @returns @true on success, @false otherwise }
  646. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  647. { add alpha channel data from function
  648. @param aFunc callback to get data from
  649. @param aArgs user defined parameters (use at will)
  650. @returns @true on success, @false otherwise }
  651. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  652. { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
  653. @param aFilename file to load alpha channel data from
  654. @param aFunc callback to use for converting
  655. @param aArgs user defined parameters (use at will)
  656. @returns @true on success, @false otherwise }
  657. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  658. { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
  659. @param aStream stream to load alpha channel data from
  660. @param aFunc callback to use for converting
  661. @param aArgs user defined parameters (use at will)
  662. @returns @true on success, @false otherwise }
  663. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  664. { add alpha channel data from existing glBitmap object
  665. @param aBitmap TglBitmap to copy alpha channel data from
  666. @param aFunc callback to use for converting
  667. @param aArgs user defined parameters (use at will)
  668. @returns @true on success, @false otherwise }
  669. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  670. { add alpha to pixel if the pixels color is greter than the given color value
  671. @param aRed red threshold (0-255)
  672. @param aGreen green threshold (0-255)
  673. @param aBlue blue threshold (0-255)
  674. @param aDeviatation accepted deviatation (0-255)
  675. @returns @true on success, @false otherwise }
  676. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  677. { add alpha to pixel if the pixels color is greter than the given color value
  678. @param aRed red threshold (0-Range.r)
  679. @param aGreen green threshold (0-Range.g)
  680. @param aBlue blue threshold (0-Range.b)
  681. @param aDeviatation accepted deviatation (0-max(Range.rgb))
  682. @returns @true on success, @false otherwise }
  683. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  684. { add alpha to pixel if the pixels color is greter than the given color value
  685. @param aRed red threshold (0.0-1.0)
  686. @param aGreen green threshold (0.0-1.0)
  687. @param aBlue blue threshold (0.0-1.0)
  688. @param aDeviatation accepted deviatation (0.0-1.0)
  689. @returns @true on success, @false otherwise }
  690. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  691. { add a constand alpha value to all pixels
  692. @param aAlpha alpha value to add (0-255)
  693. @returns @true on success, @false otherwise }
  694. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  695. { add a constand alpha value to all pixels
  696. @param aAlpha alpha value to add (0-max(Range.rgb))
  697. @returns @true on success, @false otherwise }
  698. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  699. { add a constand alpha value to all pixels
  700. @param aAlpha alpha value to add (0.0-1.0)
  701. @returns @true on success, @false otherwise }
  702. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  703. { remove alpha channel
  704. @returns @true on success, @false otherwise }
  705. function RemoveAlpha: Boolean; virtual;
  706. public
  707. { create a clone of the current object
  708. @returns clone of this object}
  709. function Clone: TglBitmap;
  710. { invert color data (xor)
  711. @param aUseRGB xor each color channel
  712. @param aUseAlpha xor alpha channel }
  713. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  714. { free texture stored data }
  715. procedure FreeData;
  716. {$IFNDEF OPENGL_ES}
  717. { set the new value for texture border color
  718. @param aRed red color for border (0.0-1.0)
  719. @param aGreen green color for border (0.0-1.0)
  720. @param aBlue blue color for border (0.0-1.0)
  721. @param aAlpha alpha color for border (0.0-1.0) }
  722. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  723. {$ENDIF}
  724. public
  725. { fill complete texture with one color
  726. @param aRed red color for border (0-255)
  727. @param aGreen green color for border (0-255)
  728. @param aBlue blue color for border (0-255)
  729. @param aAlpha alpha color for border (0-255) }
  730. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  731. { fill complete texture with one color
  732. @param aRed red color for border (0-Range.r)
  733. @param aGreen green color for border (0-Range.g)
  734. @param aBlue blue color for border (0-Range.b)
  735. @param aAlpha alpha color for border (0-Range.a) }
  736. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  737. { fill complete texture with one color
  738. @param aRed red color for border (0.0-1.0)
  739. @param aGreen green color for border (0.0-1.0)
  740. @param aBlue blue color for border (0.0-1.0)
  741. @param aAlpha alpha color for border (0.0-1.0) }
  742. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
  743. public
  744. { set new texture filer
  745. @param aMin min filter
  746. @param aMag mag filter }
  747. procedure SetFilter(const aMin, aMag: GLenum);
  748. { set new texture wrapping
  749. @param S texture wrapping for x axis
  750. @param T texture wrapping for y axis
  751. @param R texture wrapping for z axis }
  752. procedure SetWrap(
  753. const S: GLenum = GL_CLAMP_TO_EDGE;
  754. const T: GLenum = GL_CLAMP_TO_EDGE;
  755. const R: GLenum = GL_CLAMP_TO_EDGE);
  756. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  757. { set new swizzle
  758. @param r swizzle for red channel
  759. @param g swizzle for green channel
  760. @param b swizzle for blue channel
  761. @param a swizzle for alpha channel }
  762. procedure SetSwizzle(const r, g, b, a: GLenum);
  763. {$IFEND}
  764. public
  765. { bind texture
  766. @param aEnableTextureUnit enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
  767. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  768. { bind texture
  769. @param aDisableTextureUnit disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
  770. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  771. public
  772. { constructor - created an empty texture }
  773. constructor Create; overload;
  774. { constructor - creates a texture and load it from a file
  775. @param aFilename file to load texture from }
  776. constructor Create(const aFileName: String); overload;
  777. { constructor - creates a texture and load it from a stream
  778. @param aStream stream to load texture from }
  779. constructor Create(const aStream: TStream); overload;
  780. { constructor - creates a texture with the given size, format and data
  781. @param aSize size of the texture
  782. @param aFormat format of the given data
  783. @param aData texture data - be carefull: the data will now be managed by the glBitmap object,
  784. you can control this by setting DeleteTextureOnFree, FreeDataOnDestroy and FreeDataAfterGenTexture }
  785. constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  786. { constructor - creates a texture with the given size and format and uses the given callback to create the data
  787. @param aSize size of the texture
  788. @param aFormat format of the given data
  789. @param aFunc callback to use for generating the data
  790. @param aArgs user defined parameters (use at will) }
  791. constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  792. { constructor - creates a texture and loads it from a resource
  793. @param aInstance resource handle
  794. @param aResource resource indentifier
  795. @param aResType resource type (if known) }
  796. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  797. { constructor - creates a texture and loads it from a resource
  798. @param aInstance resource handle
  799. @param aResourceID resource ID
  800. @param aResType resource type (if known) }
  801. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  802. private
  803. {$IFDEF GLB_SUPPORT_PNG_READ}
  804. { try to load a PNG from a stream
  805. @param aStream stream to load PNG from
  806. @returns @true on success, @false otherwise }
  807. function LoadPNG(const aStream: TStream): Boolean; virtual;
  808. {$ENDIF}
  809. {$ifdef GLB_SUPPORT_PNG_WRITE}
  810. { save texture data as PNG to stream
  811. @param aStream stream to save data to}
  812. procedure SavePNG(const aStream: TStream); virtual;
  813. {$ENDIF}
  814. {$IFDEF GLB_SUPPORT_JPEG_READ}
  815. { try to load a JPEG from a stream
  816. @param aStream stream to load JPEG from
  817. @returns @true on success, @false otherwise }
  818. function LoadJPEG(const aStream: TStream): Boolean; virtual;
  819. {$ENDIF}
  820. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  821. { save texture data as JPEG to stream
  822. @param aStream stream to save data to}
  823. procedure SaveJPEG(const aStream: TStream); virtual;
  824. {$ENDIF}
  825. { try to load a RAW image from a stream
  826. @param aStream stream to load RAW image from
  827. @returns @true on success, @false otherwise }
  828. function LoadRAW(const aStream: TStream): Boolean;
  829. { save texture data as RAW image to stream
  830. @param aStream stream to save data to}
  831. procedure SaveRAW(const aStream: TStream);
  832. { try to load a BMP from a stream
  833. @param aStream stream to load BMP from
  834. @returns @true on success, @false otherwise }
  835. function LoadBMP(const aStream: TStream): Boolean;
  836. { save texture data as BMP to stream
  837. @param aStream stream to save data to}
  838. procedure SaveBMP(const aStream: TStream);
  839. { try to load a TGA from a stream
  840. @param aStream stream to load TGA from
  841. @returns @true on success, @false otherwise }
  842. function LoadTGA(const aStream: TStream): Boolean;
  843. { save texture data as TGA to stream
  844. @param aStream stream to save data to}
  845. procedure SaveTGA(const aStream: TStream);
  846. { try to load a DDS from a stream
  847. @param aStream stream to load DDS from
  848. @returns @true on success, @false otherwise }
  849. function LoadDDS(const aStream: TStream): Boolean;
  850. { save texture data as DDS to stream
  851. @param aStream stream to save data to}
  852. procedure SaveDDS(const aStream: TStream);
  853. end;
  854. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  855. {$IF NOT DEFINED(OPENGL_ES)}
  856. { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D }
  857. TglBitmap1D = class(TglBitmap)
  858. protected
  859. { set data pointer of texture data
  860. @param aData pointer to new texture data (be carefull, aData could be freed by this function)
  861. @param aFormat format of the data stored at aData
  862. @param aWidth width of the texture data
  863. @param aHeight height of the texture data }
  864. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  865. { upload the texture data to video card
  866. @param aBuildWithGlu use glu functions to build mipmaps }
  867. procedure UploadData(const aBuildWithGlu: Boolean);
  868. public
  869. property Width; //< actual with of the texture
  870. { this method is called after constructor and initializes the object }
  871. procedure AfterConstruction; override;
  872. { flip texture horizontally
  873. @returns @true on success, @fals otherwise }
  874. function FlipHorz: Boolean; override;
  875. { generate texture (create texture object if not exist, set texture parameters and upload data
  876. @param aTestTextureSize check the size of the texture and throw exception if something is wrong }
  877. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  878. end;
  879. {$IFEND}
  880. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  881. { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D) }
  882. TglBitmap2D = class(TglBitmap)
  883. protected
  884. fLines: array of PByte; //< array to store scanline entry points in
  885. { get a specific scanline
  886. @param aIndex index of the scanline to return
  887. @returns scanline at position aIndex or @nil }
  888. function GetScanline(const aIndex: Integer): Pointer;
  889. { set data pointer of texture data
  890. @param aData pointer to new texture data (be carefull, aData could be freed by this function)
  891. @param aFormat format of the data stored at aData
  892. @param aWidth width of the texture data
  893. @param aHeight height of the texture data }
  894. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  895. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  896. { upload the texture data to video card
  897. @param aTarget target o upload data to (e.g. GL_TEXTURE_2D)
  898. @param aBuildWithGlu use glu functions to build mipmaps }
  899. procedure UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
  900. public
  901. property Width; //< actual width of the texture
  902. property Height; //< actual height of the texture
  903. property Scanline[const aIndex: Integer]: Pointer read GetScanline; //< scanline to access texture data directly
  904. { this method is called after constructor and initializes the object }
  905. procedure AfterConstruction; override;
  906. { copy a part of the frame buffer top the texture
  907. @param aTop topmost pixel to copy
  908. @param aLeft leftmost pixel to copy
  909. @param aRight rightmost pixel to copy
  910. @param aBottom bottommost pixel to copy
  911. @param aFormat format to store data in }
  912. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  913. {$IFNDEF OPENGL_ES}
  914. { downlaod texture data from OpenGL texture object }
  915. procedure GetDataFromTexture;
  916. {$ENDIF}
  917. { generate texture (create texture object if not exist, set texture parameters and upload data)
  918. @param aTestTextureSize check the size of the texture and throw exception if something is wrong }
  919. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  920. { flip texture horizontally
  921. @returns @true on success, @false otherwise }
  922. function FlipHorz: Boolean; override;
  923. { flip texture vertically
  924. @returns @true on success, @false otherwise }
  925. function FlipVert: Boolean; override;
  926. { create normal map from texture data
  927. @param aFunc normal map function to generate normalmap with
  928. @param aScale scale of the normale stored in the normal map
  929. @param aUseAlpha generate normalmap from alpha channel data (if present) }
  930. procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  931. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  932. end;
  933. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  934. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  935. { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP) }
  936. TglBitmapCubeMap = class(TglBitmap2D)
  937. protected
  938. {$IFNDEF OPENGL_ES}
  939. fGenMode: Integer; //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
  940. {$ENDIF}
  941. { generate texture (create texture object if not exist, set texture parameters and upload data
  942. do not call directly for cubemaps, use GenerateCubeMap instead
  943. @param aTestTextureSize check the size of the texture and throw exception if something is wrong }
  944. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  945. public
  946. { this method is called after constructor and initializes the object }
  947. procedure AfterConstruction; override;
  948. { generate texture (create texture object if not exist, set texture parameters and upload data
  949. @param aCubeTarget cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
  950. @param aTestTextureSize check the size of the texture and throw exception if something is wrong }
  951. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  952. { bind texture
  953. @param aEnableTexCoordsGen enable cube map generator
  954. @param aEnableTextureUnit enable texture unit }
  955. procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  956. { unbind texture
  957. @param aDisableTexCoordsGen disable cube map generator
  958. @param aDisableTextureUnit disable texture unit }
  959. procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  960. end;
  961. {$IFEND}
  962. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  963. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  964. { wrapper class for cube normal maps }
  965. TglBitmapNormalMap = class(TglBitmapCubeMap)
  966. public
  967. { this method is called after constructor and initializes the object }
  968. procedure AfterConstruction; override;
  969. { create cube normal map from texture data and upload it to video card
  970. @param aSize size of each cube map texture
  971. @param aTestTextureSize check texture size when uploading and throw exception if something is wrong }
  972. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  973. end;
  974. {$IFEND}
  975. const
  976. NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
  977. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  978. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  979. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  980. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  981. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  982. procedure glBitmapSetDefaultWrap(
  983. const S: Cardinal = GL_CLAMP_TO_EDGE;
  984. const T: Cardinal = GL_CLAMP_TO_EDGE;
  985. const R: Cardinal = GL_CLAMP_TO_EDGE);
  986. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  987. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  988. {$IFEND}
  989. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  990. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  991. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  992. function glBitmapGetDefaultFormat: TglBitmapFormat;
  993. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  994. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  995. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  996. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  997. {$IFEND}
  998. function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
  999. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1000. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1001. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1002. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1003. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1004. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1005. function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
  1006. {$IFDEF GLB_DELPHI}
  1007. function CreateGrayPalette: HPALETTE;
  1008. {$ENDIF}
  1009. implementation
  1010. uses
  1011. Math, syncobjs, typinfo
  1012. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1013. var
  1014. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1015. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1016. glBitmapDefaultFormat: TglBitmapFormat;
  1017. glBitmapDefaultMipmap: TglBitmapMipMap;
  1018. glBitmapDefaultFilterMin: Cardinal;
  1019. glBitmapDefaultFilterMag: Cardinal;
  1020. glBitmapDefaultWrapS: Cardinal;
  1021. glBitmapDefaultWrapT: Cardinal;
  1022. glBitmapDefaultWrapR: Cardinal;
  1023. glDefaultSwizzle: array[0..3] of GLenum;
  1024. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1025. type
  1026. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1027. public
  1028. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1029. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1030. function GetSize(const aSize: TglBitmapSize): Integer; overload; virtual;
  1031. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1032. function CreateMappingData: Pointer; virtual;
  1033. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1034. function IsEmpty: Boolean; virtual;
  1035. function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
  1036. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1037. constructor Create; virtual;
  1038. public
  1039. class procedure Init;
  1040. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1041. class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1042. class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
  1043. class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  1044. class procedure Clear;
  1045. class procedure Finalize;
  1046. end;
  1047. TFormatDescriptorClass = class of TFormatDescriptor;
  1048. TfdEmpty = class(TFormatDescriptor);
  1049. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1050. TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
  1051. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1052. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1053. end;
  1054. TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
  1055. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1056. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1057. end;
  1058. TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
  1059. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1060. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1061. end;
  1062. TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
  1063. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1064. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1065. end;
  1066. TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
  1067. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1068. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1069. end;
  1070. TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1071. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1072. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1073. end;
  1074. TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
  1075. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1076. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1077. end;
  1078. TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
  1079. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1080. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1081. end;
  1082. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1083. TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
  1084. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1085. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1086. end;
  1087. TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
  1088. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1089. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1090. end;
  1091. TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
  1092. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1093. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1094. end;
  1095. TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
  1096. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1097. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1098. end;
  1099. TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
  1100. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1101. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1102. end;
  1103. TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
  1104. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1105. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1106. end;
  1107. TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1108. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1109. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1110. end;
  1111. TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
  1112. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1113. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1114. end;
  1115. TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
  1116. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1117. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1118. end;
  1119. TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1120. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1121. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1122. end;
  1123. TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1124. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1125. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1126. end;
  1127. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1128. TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
  1129. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1130. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1131. end;
  1132. TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
  1133. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1134. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1135. end;
  1136. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1137. TfdAlpha4ub1 = class(TfdAlphaUB1)
  1138. procedure SetValues; override;
  1139. end;
  1140. TfdAlpha8ub1 = class(TfdAlphaUB1)
  1141. procedure SetValues; override;
  1142. end;
  1143. TfdAlpha16us1 = class(TfdAlphaUS1)
  1144. procedure SetValues; override;
  1145. end;
  1146. TfdLuminance4ub1 = class(TfdLuminanceUB1)
  1147. procedure SetValues; override;
  1148. end;
  1149. TfdLuminance8ub1 = class(TfdLuminanceUB1)
  1150. procedure SetValues; override;
  1151. end;
  1152. TfdLuminance16us1 = class(TfdLuminanceUS1)
  1153. procedure SetValues; override;
  1154. end;
  1155. TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
  1156. procedure SetValues; override;
  1157. end;
  1158. TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
  1159. procedure SetValues; override;
  1160. end;
  1161. TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
  1162. procedure SetValues; override;
  1163. end;
  1164. TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
  1165. procedure SetValues; override;
  1166. end;
  1167. TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
  1168. procedure SetValues; override;
  1169. end;
  1170. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1171. TfdR3G3B2ub1 = class(TfdUniversalUB1)
  1172. procedure SetValues; override;
  1173. end;
  1174. TfdRGBX4us1 = class(TfdUniversalUS1)
  1175. procedure SetValues; override;
  1176. end;
  1177. TfdXRGB4us1 = class(TfdUniversalUS1)
  1178. procedure SetValues; override;
  1179. end;
  1180. TfdR5G6B5us1 = class(TfdUniversalUS1)
  1181. procedure SetValues; override;
  1182. end;
  1183. TfdRGB5X1us1 = class(TfdUniversalUS1)
  1184. procedure SetValues; override;
  1185. end;
  1186. TfdX1RGB5us1 = class(TfdUniversalUS1)
  1187. procedure SetValues; override;
  1188. end;
  1189. TfdRGB8ub3 = class(TfdRGBub3)
  1190. procedure SetValues; override;
  1191. end;
  1192. TfdRGBX8ui1 = class(TfdUniversalUI1)
  1193. procedure SetValues; override;
  1194. end;
  1195. TfdXRGB8ui1 = class(TfdUniversalUI1)
  1196. procedure SetValues; override;
  1197. end;
  1198. TfdRGB10X2ui1 = class(TfdUniversalUI1)
  1199. procedure SetValues; override;
  1200. end;
  1201. TfdX2RGB10ui1 = class(TfdUniversalUI1)
  1202. procedure SetValues; override;
  1203. end;
  1204. TfdRGB16us3 = class(TfdRGBus3)
  1205. procedure SetValues; override;
  1206. end;
  1207. TfdRGBA4us1 = class(TfdUniversalUS1)
  1208. procedure SetValues; override;
  1209. end;
  1210. TfdARGB4us1 = class(TfdUniversalUS1)
  1211. procedure SetValues; override;
  1212. end;
  1213. TfdRGB5A1us1 = class(TfdUniversalUS1)
  1214. procedure SetValues; override;
  1215. end;
  1216. TfdA1RGB5us1 = class(TfdUniversalUS1)
  1217. procedure SetValues; override;
  1218. end;
  1219. TfdRGBA8ui1 = class(TfdUniversalUI1)
  1220. procedure SetValues; override;
  1221. end;
  1222. TfdARGB8ui1 = class(TfdUniversalUI1)
  1223. procedure SetValues; override;
  1224. end;
  1225. TfdRGBA8ub4 = class(TfdRGBAub4)
  1226. procedure SetValues; override;
  1227. end;
  1228. TfdRGB10A2ui1 = class(TfdUniversalUI1)
  1229. procedure SetValues; override;
  1230. end;
  1231. TfdA2RGB10ui1 = class(TfdUniversalUI1)
  1232. procedure SetValues; override;
  1233. end;
  1234. TfdRGBA16us4 = class(TfdRGBAus4)
  1235. procedure SetValues; override;
  1236. end;
  1237. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1238. TfdBGRX4us1 = class(TfdUniversalUS1)
  1239. procedure SetValues; override;
  1240. end;
  1241. TfdXBGR4us1 = class(TfdUniversalUS1)
  1242. procedure SetValues; override;
  1243. end;
  1244. TfdB5G6R5us1 = class(TfdUniversalUS1)
  1245. procedure SetValues; override;
  1246. end;
  1247. TfdBGR5X1us1 = class(TfdUniversalUS1)
  1248. procedure SetValues; override;
  1249. end;
  1250. TfdX1BGR5us1 = class(TfdUniversalUS1)
  1251. procedure SetValues; override;
  1252. end;
  1253. TfdBGR8ub3 = class(TfdBGRub3)
  1254. procedure SetValues; override;
  1255. end;
  1256. TfdBGRX8ui1 = class(TfdUniversalUI1)
  1257. procedure SetValues; override;
  1258. end;
  1259. TfdXBGR8ui1 = class(TfdUniversalUI1)
  1260. procedure SetValues; override;
  1261. end;
  1262. TfdBGR10X2ui1 = class(TfdUniversalUI1)
  1263. procedure SetValues; override;
  1264. end;
  1265. TfdX2BGR10ui1 = class(TfdUniversalUI1)
  1266. procedure SetValues; override;
  1267. end;
  1268. TfdBGR16us3 = class(TfdBGRus3)
  1269. procedure SetValues; override;
  1270. end;
  1271. TfdBGRA4us1 = class(TfdUniversalUS1)
  1272. procedure SetValues; override;
  1273. end;
  1274. TfdABGR4us1 = class(TfdUniversalUS1)
  1275. procedure SetValues; override;
  1276. end;
  1277. TfdBGR5A1us1 = class(TfdUniversalUS1)
  1278. procedure SetValues; override;
  1279. end;
  1280. TfdA1BGR5us1 = class(TfdUniversalUS1)
  1281. procedure SetValues; override;
  1282. end;
  1283. TfdBGRA8ui1 = class(TfdUniversalUI1)
  1284. procedure SetValues; override;
  1285. end;
  1286. TfdABGR8ui1 = class(TfdUniversalUI1)
  1287. procedure SetValues; override;
  1288. end;
  1289. TfdBGRA8ub4 = class(TfdBGRAub4)
  1290. procedure SetValues; override;
  1291. end;
  1292. TfdBGR10A2ui1 = class(TfdUniversalUI1)
  1293. procedure SetValues; override;
  1294. end;
  1295. TfdA2BGR10ui1 = class(TfdUniversalUI1)
  1296. procedure SetValues; override;
  1297. end;
  1298. TfdBGRA16us4 = class(TfdBGRAus4)
  1299. procedure SetValues; override;
  1300. end;
  1301. TfdDepth16us1 = class(TfdDepthUS1)
  1302. procedure SetValues; override;
  1303. end;
  1304. TfdDepth24ui1 = class(TfdDepthUI1)
  1305. procedure SetValues; override;
  1306. end;
  1307. TfdDepth32ui1 = class(TfdDepthUI1)
  1308. procedure SetValues; override;
  1309. end;
  1310. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1311. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1312. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1313. procedure SetValues; override;
  1314. end;
  1315. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1316. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1317. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1318. procedure SetValues; override;
  1319. end;
  1320. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1321. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1322. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1323. procedure SetValues; override;
  1324. end;
  1325. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1326. TbmpBitfieldFormat = class(TFormatDescriptor)
  1327. public
  1328. procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
  1329. procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1330. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1331. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1332. end;
  1333. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1334. TbmpColorTableEnty = packed record
  1335. b, g, r, a: Byte;
  1336. end;
  1337. TbmpColorTable = array of TbmpColorTableEnty;
  1338. TbmpColorTableFormat = class(TFormatDescriptor)
  1339. private
  1340. fBitsPerPixel: Integer;
  1341. fColorTable: TbmpColorTable;
  1342. protected
  1343. procedure SetValues; override;
  1344. public
  1345. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1346. property BitsPerPixel: Integer read fBitsPerPixel write fBitsPerPixel;
  1347. procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1348. procedure CalcValues;
  1349. procedure CreateColorTable;
  1350. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1351. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1352. destructor Destroy; override;
  1353. end;
  1354. const
  1355. LUMINANCE_WEIGHT_R = 0.30;
  1356. LUMINANCE_WEIGHT_G = 0.59;
  1357. LUMINANCE_WEIGHT_B = 0.11;
  1358. ALPHA_WEIGHT_R = 0.30;
  1359. ALPHA_WEIGHT_G = 0.59;
  1360. ALPHA_WEIGHT_B = 0.11;
  1361. DEPTH_WEIGHT_R = 0.333333333;
  1362. DEPTH_WEIGHT_G = 0.333333333;
  1363. DEPTH_WEIGHT_B = 0.333333333;
  1364. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1365. TfdEmpty,
  1366. TfdAlpha4ub1,
  1367. TfdAlpha8ub1,
  1368. TfdAlpha16us1,
  1369. TfdLuminance4ub1,
  1370. TfdLuminance8ub1,
  1371. TfdLuminance16us1,
  1372. TfdLuminance4Alpha4ub2,
  1373. TfdLuminance6Alpha2ub2,
  1374. TfdLuminance8Alpha8ub2,
  1375. TfdLuminance12Alpha4us2,
  1376. TfdLuminance16Alpha16us2,
  1377. TfdR3G3B2ub1,
  1378. TfdRGBX4us1,
  1379. TfdXRGB4us1,
  1380. TfdR5G6B5us1,
  1381. TfdRGB5X1us1,
  1382. TfdX1RGB5us1,
  1383. TfdRGB8ub3,
  1384. TfdRGBX8ui1,
  1385. TfdXRGB8ui1,
  1386. TfdRGB10X2ui1,
  1387. TfdX2RGB10ui1,
  1388. TfdRGB16us3,
  1389. TfdRGBA4us1,
  1390. TfdARGB4us1,
  1391. TfdRGB5A1us1,
  1392. TfdA1RGB5us1,
  1393. TfdRGBA8ui1,
  1394. TfdARGB8ui1,
  1395. TfdRGBA8ub4,
  1396. TfdRGB10A2ui1,
  1397. TfdA2RGB10ui1,
  1398. TfdRGBA16us4,
  1399. TfdBGRX4us1,
  1400. TfdXBGR4us1,
  1401. TfdB5G6R5us1,
  1402. TfdBGR5X1us1,
  1403. TfdX1BGR5us1,
  1404. TfdBGR8ub3,
  1405. TfdBGRX8ui1,
  1406. TfdXBGR8ui1,
  1407. TfdBGR10X2ui1,
  1408. TfdX2BGR10ui1,
  1409. TfdBGR16us3,
  1410. TfdBGRA4us1,
  1411. TfdABGR4us1,
  1412. TfdBGR5A1us1,
  1413. TfdA1BGR5us1,
  1414. TfdBGRA8ui1,
  1415. TfdABGR8ui1,
  1416. TfdBGRA8ub4,
  1417. TfdBGR10A2ui1,
  1418. TfdA2BGR10ui1,
  1419. TfdBGRA16us4,
  1420. TfdDepth16us1,
  1421. TfdDepth24ui1,
  1422. TfdDepth32ui1,
  1423. TfdS3tcDtx1RGBA,
  1424. TfdS3tcDtx3RGBA,
  1425. TfdS3tcDtx5RGBA
  1426. );
  1427. var
  1428. FormatDescriptorCS: TCriticalSection;
  1429. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1430. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1431. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1432. begin
  1433. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1434. end;
  1435. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1436. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1437. begin
  1438. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1439. end;
  1440. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1441. function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
  1442. begin
  1443. result.Fields := [];
  1444. if (X >= 0) then
  1445. result.Fields := result.Fields + [ffX];
  1446. if (Y >= 0) then
  1447. result.Fields := result.Fields + [ffY];
  1448. result.X := Max(0, X);
  1449. result.Y := Max(0, Y);
  1450. end;
  1451. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1452. function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
  1453. begin
  1454. result := glBitmapSize(X, Y);
  1455. end;
  1456. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1457. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1458. begin
  1459. result.r := r;
  1460. result.g := g;
  1461. result.b := b;
  1462. result.a := a;
  1463. end;
  1464. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1465. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1466. begin
  1467. result.r := r;
  1468. result.g := g;
  1469. result.b := b;
  1470. result.a := a;
  1471. end;
  1472. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1473. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1474. begin
  1475. result.r := r;
  1476. result.g := g;
  1477. result.b := b;
  1478. result.a := a;
  1479. end;
  1480. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1481. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1482. var
  1483. i: Integer;
  1484. begin
  1485. result := false;
  1486. for i := 0 to high(r1.arr) do
  1487. if (r1.arr[i] <> r2.arr[i]) then
  1488. exit;
  1489. result := true;
  1490. end;
  1491. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1492. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1493. var
  1494. i: Integer;
  1495. begin
  1496. result := false;
  1497. for i := 0 to high(r1.arr) do
  1498. if (r1.arr[i] <> r2.arr[i]) then
  1499. exit;
  1500. result := true;
  1501. end;
  1502. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1503. function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
  1504. var
  1505. desc: TFormatDescriptor;
  1506. p, tmp: PByte;
  1507. x, y, i: Integer;
  1508. md: Pointer;
  1509. px: TglBitmapPixelData;
  1510. begin
  1511. result := nil;
  1512. desc := TFormatDescriptor.Get(aFormat);
  1513. if (desc.IsCompressed) or (desc.glFormat = 0) then
  1514. exit;
  1515. p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
  1516. md := desc.CreateMappingData;
  1517. try
  1518. tmp := p;
  1519. desc.PreparePixel(px);
  1520. for y := 0 to 4 do
  1521. for x := 0 to 4 do begin
  1522. px.Data := glBitmapRec4ui(0, 0, 0, 0);
  1523. for i := 0 to 3 do begin
  1524. if ((y < 3) and (y = i)) or
  1525. ((y = 3) and (i < 3)) or
  1526. ((y = 4) and (i = 3))
  1527. then
  1528. px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
  1529. else if ((y < 4) and (i = 3)) or
  1530. ((y = 4) and (i < 3))
  1531. then
  1532. px.Data.arr[i] := px.Range.arr[i]
  1533. else
  1534. px.Data.arr[i] := 0; //px.Range.arr[i];
  1535. end;
  1536. desc.Map(px, tmp, md);
  1537. end;
  1538. finally
  1539. desc.FreeMappingData(md);
  1540. end;
  1541. result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
  1542. result.FreeDataOnDestroy := true;
  1543. result.FreeDataAfterGenTexture := false;
  1544. result.SetFilter(GL_NEAREST, GL_NEAREST);
  1545. end;
  1546. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1547. function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
  1548. begin
  1549. result.r := r;
  1550. result.g := g;
  1551. result.b := b;
  1552. result.a := a;
  1553. end;
  1554. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1555. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1556. begin
  1557. result := [];
  1558. if (aFormat in [
  1559. //8bpp
  1560. tfAlpha4ub1, tfAlpha8ub1,
  1561. tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
  1562. //16bpp
  1563. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1564. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  1565. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
  1566. //24bpp
  1567. tfBGR8ub3, tfRGB8ub3,
  1568. //32bpp
  1569. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  1570. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
  1571. then
  1572. result := result + [ ftBMP ];
  1573. if (aFormat in [
  1574. //8bbp
  1575. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
  1576. //16bbp
  1577. tfAlpha16us1, tfLuminance16us1,
  1578. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1579. tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
  1580. //24bbp
  1581. tfBGR8ub3,
  1582. //32bbp
  1583. tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
  1584. tfDepth24ui1, tfDepth32ui1])
  1585. then
  1586. result := result + [ftTGA];
  1587. if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
  1588. result := result + [ftDDS];
  1589. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1590. if aFormat in [
  1591. tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
  1592. tfRGB8ub3, tfRGBA8ui1,
  1593. tfBGR8ub3, tfBGRA8ui1] then
  1594. result := result + [ftPNG];
  1595. {$ENDIF}
  1596. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1597. if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
  1598. result := result + [ftJPEG];
  1599. {$ENDIF}
  1600. end;
  1601. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1602. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1603. begin
  1604. while (aNumber and 1) = 0 do
  1605. aNumber := aNumber shr 1;
  1606. result := aNumber = 1;
  1607. end;
  1608. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1609. function GetTopMostBit(aBitSet: QWord): Integer;
  1610. begin
  1611. result := 0;
  1612. while aBitSet > 0 do begin
  1613. inc(result);
  1614. aBitSet := aBitSet shr 1;
  1615. end;
  1616. end;
  1617. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1618. function CountSetBits(aBitSet: QWord): Integer;
  1619. begin
  1620. result := 0;
  1621. while aBitSet > 0 do begin
  1622. if (aBitSet and 1) = 1 then
  1623. inc(result);
  1624. aBitSet := aBitSet shr 1;
  1625. end;
  1626. end;
  1627. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1628. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1629. begin
  1630. result := Trunc(
  1631. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1632. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1633. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1634. end;
  1635. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1636. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1637. begin
  1638. result := Trunc(
  1639. DEPTH_WEIGHT_R * aPixel.Data.r +
  1640. DEPTH_WEIGHT_G * aPixel.Data.g +
  1641. DEPTH_WEIGHT_B * aPixel.Data.b);
  1642. end;
  1643. {$IFDEF GLB_SDL_IMAGE}
  1644. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1645. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1646. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1647. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1648. begin
  1649. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1650. end;
  1651. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1652. begin
  1653. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1654. end;
  1655. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1656. begin
  1657. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1658. end;
  1659. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1660. begin
  1661. result := 0;
  1662. end;
  1663. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1664. begin
  1665. result := SDL_AllocRW;
  1666. if result = nil then
  1667. raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1668. result^.seek := glBitmapRWseek;
  1669. result^.read := glBitmapRWread;
  1670. result^.write := glBitmapRWwrite;
  1671. result^.close := glBitmapRWclose;
  1672. result^.unknown.data1 := Stream;
  1673. end;
  1674. {$ENDIF}
  1675. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1676. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1677. begin
  1678. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1679. end;
  1680. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1681. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1682. begin
  1683. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1684. end;
  1685. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1686. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1687. begin
  1688. glBitmapDefaultMipmap := aValue;
  1689. end;
  1690. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1691. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1692. begin
  1693. glBitmapDefaultFormat := aFormat;
  1694. end;
  1695. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1696. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1697. begin
  1698. glBitmapDefaultFilterMin := aMin;
  1699. glBitmapDefaultFilterMag := aMag;
  1700. end;
  1701. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1702. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1703. begin
  1704. glBitmapDefaultWrapS := S;
  1705. glBitmapDefaultWrapT := T;
  1706. glBitmapDefaultWrapR := R;
  1707. end;
  1708. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1709. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1710. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1711. begin
  1712. glDefaultSwizzle[0] := r;
  1713. glDefaultSwizzle[1] := g;
  1714. glDefaultSwizzle[2] := b;
  1715. glDefaultSwizzle[3] := a;
  1716. end;
  1717. {$IFEND}
  1718. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1719. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1720. begin
  1721. result := glBitmapDefaultDeleteTextureOnFree;
  1722. end;
  1723. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1724. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1725. begin
  1726. result := glBitmapDefaultFreeDataAfterGenTextures;
  1727. end;
  1728. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1729. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1730. begin
  1731. result := glBitmapDefaultMipmap;
  1732. end;
  1733. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1734. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1735. begin
  1736. result := glBitmapDefaultFormat;
  1737. end;
  1738. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1739. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1740. begin
  1741. aMin := glBitmapDefaultFilterMin;
  1742. aMag := glBitmapDefaultFilterMag;
  1743. end;
  1744. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1745. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1746. begin
  1747. S := glBitmapDefaultWrapS;
  1748. T := glBitmapDefaultWrapT;
  1749. R := glBitmapDefaultWrapR;
  1750. end;
  1751. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1752. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1753. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1754. begin
  1755. r := glDefaultSwizzle[0];
  1756. g := glDefaultSwizzle[1];
  1757. b := glDefaultSwizzle[2];
  1758. a := glDefaultSwizzle[3];
  1759. end;
  1760. {$ENDIF}
  1761. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1762. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1763. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1764. function TFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
  1765. var
  1766. w, h: Integer;
  1767. begin
  1768. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  1769. w := Max(1, aSize.X);
  1770. h := Max(1, aSize.Y);
  1771. result := GetSize(w, h);
  1772. end else
  1773. result := 0;
  1774. end;
  1775. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1776. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  1777. begin
  1778. result := 0;
  1779. if (aWidth <= 0) or (aHeight <= 0) then
  1780. exit;
  1781. result := Ceil(aWidth * aHeight * BytesPerPixel);
  1782. end;
  1783. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1784. function TFormatDescriptor.CreateMappingData: Pointer;
  1785. begin
  1786. result := nil;
  1787. end;
  1788. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1789. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  1790. begin
  1791. //DUMMY
  1792. end;
  1793. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1794. function TFormatDescriptor.IsEmpty: Boolean;
  1795. begin
  1796. result := (fFormat = tfEmpty);
  1797. end;
  1798. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1799. function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
  1800. var
  1801. i: Integer;
  1802. m: TglBitmapRec4ul;
  1803. begin
  1804. result := false;
  1805. if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
  1806. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  1807. m := Mask;
  1808. for i := 0 to 3 do
  1809. if (aMask.arr[i] <> m.arr[i]) then
  1810. exit;
  1811. result := true;
  1812. end;
  1813. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1814. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  1815. begin
  1816. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  1817. aPixel.Data := Range;
  1818. aPixel.Format := fFormat;
  1819. aPixel.Range := Range;
  1820. end;
  1821. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1822. constructor TFormatDescriptor.Create;
  1823. begin
  1824. inherited Create;
  1825. end;
  1826. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1827. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1828. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1829. procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1830. begin
  1831. aData^ := aPixel.Data.a;
  1832. inc(aData);
  1833. end;
  1834. procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1835. begin
  1836. aPixel.Data.r := 0;
  1837. aPixel.Data.g := 0;
  1838. aPixel.Data.b := 0;
  1839. aPixel.Data.a := aData^;
  1840. inc(aData);
  1841. end;
  1842. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1843. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1844. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1845. procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1846. begin
  1847. aData^ := LuminanceWeight(aPixel);
  1848. inc(aData);
  1849. end;
  1850. procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1851. begin
  1852. aPixel.Data.r := aData^;
  1853. aPixel.Data.g := aData^;
  1854. aPixel.Data.b := aData^;
  1855. aPixel.Data.a := 0;
  1856. inc(aData);
  1857. end;
  1858. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1859. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1860. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1861. procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1862. var
  1863. i: Integer;
  1864. begin
  1865. aData^ := 0;
  1866. for i := 0 to 3 do
  1867. if (Range.arr[i] > 0) then
  1868. aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  1869. inc(aData);
  1870. end;
  1871. procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1872. var
  1873. i: Integer;
  1874. begin
  1875. for i := 0 to 3 do
  1876. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
  1877. inc(aData);
  1878. end;
  1879. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1880. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1881. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1882. procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1883. begin
  1884. inherited Map(aPixel, aData, aMapData);
  1885. aData^ := aPixel.Data.a;
  1886. inc(aData);
  1887. end;
  1888. procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1889. begin
  1890. inherited Unmap(aData, aPixel, aMapData);
  1891. aPixel.Data.a := aData^;
  1892. inc(aData);
  1893. end;
  1894. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1895. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1896. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1897. procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1898. begin
  1899. aData^ := aPixel.Data.r;
  1900. inc(aData);
  1901. aData^ := aPixel.Data.g;
  1902. inc(aData);
  1903. aData^ := aPixel.Data.b;
  1904. inc(aData);
  1905. end;
  1906. procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1907. begin
  1908. aPixel.Data.r := aData^;
  1909. inc(aData);
  1910. aPixel.Data.g := aData^;
  1911. inc(aData);
  1912. aPixel.Data.b := aData^;
  1913. inc(aData);
  1914. aPixel.Data.a := 0;
  1915. end;
  1916. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1917. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1918. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1919. procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1920. begin
  1921. aData^ := aPixel.Data.b;
  1922. inc(aData);
  1923. aData^ := aPixel.Data.g;
  1924. inc(aData);
  1925. aData^ := aPixel.Data.r;
  1926. inc(aData);
  1927. end;
  1928. procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1929. begin
  1930. aPixel.Data.b := aData^;
  1931. inc(aData);
  1932. aPixel.Data.g := aData^;
  1933. inc(aData);
  1934. aPixel.Data.r := aData^;
  1935. inc(aData);
  1936. aPixel.Data.a := 0;
  1937. end;
  1938. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1939. //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1940. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1941. procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1942. begin
  1943. inherited Map(aPixel, aData, aMapData);
  1944. aData^ := aPixel.Data.a;
  1945. inc(aData);
  1946. end;
  1947. procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1948. begin
  1949. inherited Unmap(aData, aPixel, aMapData);
  1950. aPixel.Data.a := aData^;
  1951. inc(aData);
  1952. end;
  1953. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1954. //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1955. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1956. procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1957. begin
  1958. inherited Map(aPixel, aData, aMapData);
  1959. aData^ := aPixel.Data.a;
  1960. inc(aData);
  1961. end;
  1962. procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1963. begin
  1964. inherited Unmap(aData, aPixel, aMapData);
  1965. aPixel.Data.a := aData^;
  1966. inc(aData);
  1967. end;
  1968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1969. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1970. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1971. procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1972. begin
  1973. PWord(aData)^ := aPixel.Data.a;
  1974. inc(aData, 2);
  1975. end;
  1976. procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1977. begin
  1978. aPixel.Data.r := 0;
  1979. aPixel.Data.g := 0;
  1980. aPixel.Data.b := 0;
  1981. aPixel.Data.a := PWord(aData)^;
  1982. inc(aData, 2);
  1983. end;
  1984. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1985. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1986. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1987. procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1988. begin
  1989. PWord(aData)^ := LuminanceWeight(aPixel);
  1990. inc(aData, 2);
  1991. end;
  1992. procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1993. begin
  1994. aPixel.Data.r := PWord(aData)^;
  1995. aPixel.Data.g := PWord(aData)^;
  1996. aPixel.Data.b := PWord(aData)^;
  1997. aPixel.Data.a := 0;
  1998. inc(aData, 2);
  1999. end;
  2000. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2001. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2002. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2003. procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2004. var
  2005. i: Integer;
  2006. begin
  2007. PWord(aData)^ := 0;
  2008. for i := 0 to 3 do
  2009. if (Range.arr[i] > 0) then
  2010. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2011. inc(aData, 2);
  2012. end;
  2013. procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2014. var
  2015. i: Integer;
  2016. begin
  2017. for i := 0 to 3 do
  2018. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2019. inc(aData, 2);
  2020. end;
  2021. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2022. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2023. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2024. procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2025. begin
  2026. PWord(aData)^ := DepthWeight(aPixel);
  2027. inc(aData, 2);
  2028. end;
  2029. procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2030. begin
  2031. aPixel.Data.r := PWord(aData)^;
  2032. aPixel.Data.g := PWord(aData)^;
  2033. aPixel.Data.b := PWord(aData)^;
  2034. aPixel.Data.a := PWord(aData)^;;
  2035. inc(aData, 2);
  2036. end;
  2037. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2038. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2039. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2040. procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2041. begin
  2042. inherited Map(aPixel, aData, aMapData);
  2043. PWord(aData)^ := aPixel.Data.a;
  2044. inc(aData, 2);
  2045. end;
  2046. procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2047. begin
  2048. inherited Unmap(aData, aPixel, aMapData);
  2049. aPixel.Data.a := PWord(aData)^;
  2050. inc(aData, 2);
  2051. end;
  2052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2053. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2054. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2055. procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2056. begin
  2057. PWord(aData)^ := aPixel.Data.r;
  2058. inc(aData, 2);
  2059. PWord(aData)^ := aPixel.Data.g;
  2060. inc(aData, 2);
  2061. PWord(aData)^ := aPixel.Data.b;
  2062. inc(aData, 2);
  2063. end;
  2064. procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2065. begin
  2066. aPixel.Data.r := PWord(aData)^;
  2067. inc(aData, 2);
  2068. aPixel.Data.g := PWord(aData)^;
  2069. inc(aData, 2);
  2070. aPixel.Data.b := PWord(aData)^;
  2071. inc(aData, 2);
  2072. aPixel.Data.a := 0;
  2073. end;
  2074. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2075. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2076. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2077. procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2078. begin
  2079. PWord(aData)^ := aPixel.Data.b;
  2080. inc(aData, 2);
  2081. PWord(aData)^ := aPixel.Data.g;
  2082. inc(aData, 2);
  2083. PWord(aData)^ := aPixel.Data.r;
  2084. inc(aData, 2);
  2085. end;
  2086. procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2087. begin
  2088. aPixel.Data.b := PWord(aData)^;
  2089. inc(aData, 2);
  2090. aPixel.Data.g := PWord(aData)^;
  2091. inc(aData, 2);
  2092. aPixel.Data.r := PWord(aData)^;
  2093. inc(aData, 2);
  2094. aPixel.Data.a := 0;
  2095. end;
  2096. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2097. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2098. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2099. procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2100. begin
  2101. inherited Map(aPixel, aData, aMapData);
  2102. PWord(aData)^ := aPixel.Data.a;
  2103. inc(aData, 2);
  2104. end;
  2105. procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2106. begin
  2107. inherited Unmap(aData, aPixel, aMapData);
  2108. aPixel.Data.a := PWord(aData)^;
  2109. inc(aData, 2);
  2110. end;
  2111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2112. //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2113. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2114. procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2115. begin
  2116. PWord(aData)^ := aPixel.Data.a;
  2117. inc(aData, 2);
  2118. inherited Map(aPixel, aData, aMapData);
  2119. end;
  2120. procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2121. begin
  2122. aPixel.Data.a := PWord(aData)^;
  2123. inc(aData, 2);
  2124. inherited Unmap(aData, aPixel, aMapData);
  2125. end;
  2126. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2127. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2128. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2129. procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2130. begin
  2131. inherited Map(aPixel, aData, aMapData);
  2132. PWord(aData)^ := aPixel.Data.a;
  2133. inc(aData, 2);
  2134. end;
  2135. procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2136. begin
  2137. inherited Unmap(aData, aPixel, aMapData);
  2138. aPixel.Data.a := PWord(aData)^;
  2139. inc(aData, 2);
  2140. end;
  2141. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2142. //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2143. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2144. procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2145. begin
  2146. PWord(aData)^ := aPixel.Data.a;
  2147. inc(aData, 2);
  2148. inherited Map(aPixel, aData, aMapData);
  2149. end;
  2150. procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2151. begin
  2152. aPixel.Data.a := PWord(aData)^;
  2153. inc(aData, 2);
  2154. inherited Unmap(aData, aPixel, aMapData);
  2155. end;
  2156. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2157. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2158. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2159. procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2160. var
  2161. i: Integer;
  2162. begin
  2163. PCardinal(aData)^ := 0;
  2164. for i := 0 to 3 do
  2165. if (Range.arr[i] > 0) then
  2166. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2167. inc(aData, 4);
  2168. end;
  2169. procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2170. var
  2171. i: Integer;
  2172. begin
  2173. for i := 0 to 3 do
  2174. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2175. inc(aData, 2);
  2176. end;
  2177. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2178. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2179. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2180. procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2181. begin
  2182. PCardinal(aData)^ := DepthWeight(aPixel);
  2183. inc(aData, 4);
  2184. end;
  2185. procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2186. begin
  2187. aPixel.Data.r := PCardinal(aData)^;
  2188. aPixel.Data.g := PCardinal(aData)^;
  2189. aPixel.Data.b := PCardinal(aData)^;
  2190. aPixel.Data.a := PCardinal(aData)^;
  2191. inc(aData, 4);
  2192. end;
  2193. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2194. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2195. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2196. procedure TfdAlpha4ub1.SetValues;
  2197. begin
  2198. inherited SetValues;
  2199. fBitsPerPixel := 8;
  2200. fFormat := tfAlpha4ub1;
  2201. fWithAlpha := tfAlpha4ub1;
  2202. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2203. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2204. {$IFNDEF OPENGL_ES}
  2205. fOpenGLFormat := tfAlpha4ub1;
  2206. fglFormat := GL_ALPHA;
  2207. fglInternalFormat := GL_ALPHA4;
  2208. fglDataFormat := GL_UNSIGNED_BYTE;
  2209. {$ELSE}
  2210. fOpenGLFormat := tfAlpha8ub1;
  2211. {$ENDIF}
  2212. end;
  2213. procedure TfdAlpha8ub1.SetValues;
  2214. begin
  2215. inherited SetValues;
  2216. fBitsPerPixel := 8;
  2217. fFormat := tfAlpha8ub1;
  2218. fWithAlpha := tfAlpha8ub1;
  2219. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2220. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2221. fOpenGLFormat := tfAlpha8ub1;
  2222. fglFormat := GL_ALPHA;
  2223. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
  2224. fglDataFormat := GL_UNSIGNED_BYTE;
  2225. end;
  2226. procedure TfdAlpha16us1.SetValues;
  2227. begin
  2228. inherited SetValues;
  2229. fBitsPerPixel := 16;
  2230. fFormat := tfAlpha16us1;
  2231. fWithAlpha := tfAlpha16us1;
  2232. fPrecision := glBitmapRec4ub(0, 0, 0, 16);
  2233. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2234. {$IFNDEF OPENGL_ES}
  2235. fOpenGLFormat := tfAlpha16us1;
  2236. fglFormat := GL_ALPHA;
  2237. fglInternalFormat := GL_ALPHA16;
  2238. fglDataFormat := GL_UNSIGNED_SHORT;
  2239. {$ELSE}
  2240. fOpenGLFormat := tfAlpha8ub1;
  2241. {$ENDIF}
  2242. end;
  2243. procedure TfdLuminance4ub1.SetValues;
  2244. begin
  2245. inherited SetValues;
  2246. fBitsPerPixel := 8;
  2247. fFormat := tfLuminance4ub1;
  2248. fWithAlpha := tfLuminance4Alpha4ub2;
  2249. fWithoutAlpha := tfLuminance4ub1;
  2250. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2251. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2252. {$IFNDEF OPENGL_ES}
  2253. fOpenGLFormat := tfLuminance4ub1;
  2254. fglFormat := GL_LUMINANCE;
  2255. fglInternalFormat := GL_LUMINANCE4;
  2256. fglDataFormat := GL_UNSIGNED_BYTE;
  2257. {$ELSE}
  2258. fOpenGLFormat := tfLuminance8ub1;
  2259. {$ENDIF}
  2260. end;
  2261. procedure TfdLuminance8ub1.SetValues;
  2262. begin
  2263. inherited SetValues;
  2264. fBitsPerPixel := 8;
  2265. fFormat := tfLuminance8ub1;
  2266. fWithAlpha := tfLuminance8Alpha8ub2;
  2267. fWithoutAlpha := tfLuminance8ub1;
  2268. fOpenGLFormat := tfLuminance8ub1;
  2269. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2270. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2271. fglFormat := GL_LUMINANCE;
  2272. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
  2273. fglDataFormat := GL_UNSIGNED_BYTE;
  2274. end;
  2275. procedure TfdLuminance16us1.SetValues;
  2276. begin
  2277. inherited SetValues;
  2278. fBitsPerPixel := 16;
  2279. fFormat := tfLuminance16us1;
  2280. fWithAlpha := tfLuminance16Alpha16us2;
  2281. fWithoutAlpha := tfLuminance16us1;
  2282. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2283. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  2284. {$IFNDEF OPENGL_ES}
  2285. fOpenGLFormat := tfLuminance16us1;
  2286. fglFormat := GL_LUMINANCE;
  2287. fglInternalFormat := GL_LUMINANCE16;
  2288. fglDataFormat := GL_UNSIGNED_SHORT;
  2289. {$ELSE}
  2290. fOpenGLFormat := tfLuminance8ub1;
  2291. {$ENDIF}
  2292. end;
  2293. procedure TfdLuminance4Alpha4ub2.SetValues;
  2294. begin
  2295. inherited SetValues;
  2296. fBitsPerPixel := 16;
  2297. fFormat := tfLuminance4Alpha4ub2;
  2298. fWithAlpha := tfLuminance4Alpha4ub2;
  2299. fWithoutAlpha := tfLuminance4ub1;
  2300. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2301. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2302. {$IFNDEF OPENGL_ES}
  2303. fOpenGLFormat := tfLuminance4Alpha4ub2;
  2304. fglFormat := GL_LUMINANCE_ALPHA;
  2305. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2306. fglDataFormat := GL_UNSIGNED_BYTE;
  2307. {$ELSE}
  2308. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2309. {$ENDIF}
  2310. end;
  2311. procedure TfdLuminance6Alpha2ub2.SetValues;
  2312. begin
  2313. inherited SetValues;
  2314. fBitsPerPixel := 16;
  2315. fFormat := tfLuminance6Alpha2ub2;
  2316. fWithAlpha := tfLuminance6Alpha2ub2;
  2317. fWithoutAlpha := tfLuminance8ub1;
  2318. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2319. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2320. {$IFNDEF OPENGL_ES}
  2321. fOpenGLFormat := tfLuminance6Alpha2ub2;
  2322. fglFormat := GL_LUMINANCE_ALPHA;
  2323. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2324. fglDataFormat := GL_UNSIGNED_BYTE;
  2325. {$ELSE}
  2326. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2327. {$ENDIF}
  2328. end;
  2329. procedure TfdLuminance8Alpha8ub2.SetValues;
  2330. begin
  2331. inherited SetValues;
  2332. fBitsPerPixel := 16;
  2333. fFormat := tfLuminance8Alpha8ub2;
  2334. fWithAlpha := tfLuminance8Alpha8ub2;
  2335. fWithoutAlpha := tfLuminance8ub1;
  2336. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2337. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2338. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2339. fglFormat := GL_LUMINANCE_ALPHA;
  2340. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
  2341. fglDataFormat := GL_UNSIGNED_BYTE;
  2342. end;
  2343. procedure TfdLuminance12Alpha4us2.SetValues;
  2344. begin
  2345. inherited SetValues;
  2346. fBitsPerPixel := 32;
  2347. fFormat := tfLuminance12Alpha4us2;
  2348. fWithAlpha := tfLuminance12Alpha4us2;
  2349. fWithoutAlpha := tfLuminance16us1;
  2350. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2351. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2352. {$IFNDEF OPENGL_ES}
  2353. fOpenGLFormat := tfLuminance12Alpha4us2;
  2354. fglFormat := GL_LUMINANCE_ALPHA;
  2355. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2356. fglDataFormat := GL_UNSIGNED_SHORT;
  2357. {$ELSE}
  2358. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2359. {$ENDIF}
  2360. end;
  2361. procedure TfdLuminance16Alpha16us2.SetValues;
  2362. begin
  2363. inherited SetValues;
  2364. fBitsPerPixel := 32;
  2365. fFormat := tfLuminance16Alpha16us2;
  2366. fWithAlpha := tfLuminance16Alpha16us2;
  2367. fWithoutAlpha := tfLuminance16us1;
  2368. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2369. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2370. {$IFNDEF OPENGL_ES}
  2371. fOpenGLFormat := tfLuminance16Alpha16us2;
  2372. fglFormat := GL_LUMINANCE_ALPHA;
  2373. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2374. fglDataFormat := GL_UNSIGNED_SHORT;
  2375. {$ELSE}
  2376. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2377. {$ENDIF}
  2378. end;
  2379. procedure TfdR3G3B2ub1.SetValues;
  2380. begin
  2381. inherited SetValues;
  2382. fBitsPerPixel := 8;
  2383. fFormat := tfR3G3B2ub1;
  2384. fWithAlpha := tfRGBA4us1;
  2385. fWithoutAlpha := tfR3G3B2ub1;
  2386. fRGBInverted := tfEmpty;
  2387. fPrecision := glBitmapRec4ub(3, 3, 2, 0);
  2388. fShift := glBitmapRec4ub(5, 2, 0, 0);
  2389. {$IFNDEF OPENGL_ES}
  2390. fOpenGLFormat := tfR3G3B2ub1;
  2391. fglFormat := GL_RGB;
  2392. fglInternalFormat := GL_R3_G3_B2;
  2393. fglDataFormat := GL_UNSIGNED_BYTE_3_3_2;
  2394. {$ELSE}
  2395. fOpenGLFormat := tfR5G6B5us1;
  2396. {$ENDIF}
  2397. end;
  2398. procedure TfdRGBX4us1.SetValues;
  2399. begin
  2400. inherited SetValues;
  2401. fBitsPerPixel := 16;
  2402. fFormat := tfRGBX4us1;
  2403. fWithAlpha := tfRGBA4us1;
  2404. fWithoutAlpha := tfRGBX4us1;
  2405. fRGBInverted := tfBGRX4us1;
  2406. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2407. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2408. {$IFNDEF OPENGL_ES}
  2409. fOpenGLFormat := tfRGBX4us1;
  2410. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2411. fglInternalFormat := GL_RGB4;
  2412. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2413. {$ELSE}
  2414. fOpenGLFormat := tfR5G6B5us1;
  2415. {$ENDIF}
  2416. end;
  2417. procedure TfdXRGB4us1.SetValues;
  2418. begin
  2419. inherited SetValues;
  2420. fBitsPerPixel := 16;
  2421. fFormat := tfXRGB4us1;
  2422. fWithAlpha := tfARGB4us1;
  2423. fWithoutAlpha := tfXRGB4us1;
  2424. fRGBInverted := tfXBGR4us1;
  2425. fPrecision := glBitmapRec4ub(4, 4, 4, 0);
  2426. fShift := glBitmapRec4ub(8, 4, 0, 0);
  2427. {$IFNDEF OPENGL_ES}
  2428. fOpenGLFormat := tfXRGB4us1;
  2429. fglFormat := GL_BGRA;
  2430. fglInternalFormat := GL_RGB4;
  2431. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2432. {$ELSE}
  2433. fOpenGLFormat := tfR5G6B5us1;
  2434. {$ENDIF}
  2435. end;
  2436. procedure TfdR5G6B5us1.SetValues;
  2437. begin
  2438. inherited SetValues;
  2439. fBitsPerPixel := 16;
  2440. fFormat := tfR5G6B5us1;
  2441. fWithAlpha := tfRGB5A1us1;
  2442. fWithoutAlpha := tfR5G6B5us1;
  2443. fRGBInverted := tfB5G6R5us1;
  2444. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2445. fShift := glBitmapRec4ub(11, 5, 0, 0);
  2446. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  2447. fOpenGLFormat := tfR5G6B5us1;
  2448. fglFormat := GL_RGB;
  2449. fglInternalFormat := GL_RGB565;
  2450. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2451. {$ELSE}
  2452. fOpenGLFormat := tfRGB8ub3;
  2453. {$IFEND}
  2454. end;
  2455. procedure TfdRGB5X1us1.SetValues;
  2456. begin
  2457. inherited SetValues;
  2458. fBitsPerPixel := 16;
  2459. fFormat := tfRGB5X1us1;
  2460. fWithAlpha := tfRGB5A1us1;
  2461. fWithoutAlpha := tfRGB5X1us1;
  2462. fRGBInverted := tfBGR5X1us1;
  2463. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2464. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2465. {$IFNDEF OPENGL_ES}
  2466. fOpenGLFormat := tfRGB5X1us1;
  2467. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2468. fglInternalFormat := GL_RGB5;
  2469. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2470. {$ELSE}
  2471. fOpenGLFormat := tfR5G6B5us1;
  2472. {$ENDIF}
  2473. end;
  2474. procedure TfdX1RGB5us1.SetValues;
  2475. begin
  2476. inherited SetValues;
  2477. fBitsPerPixel := 16;
  2478. fFormat := tfX1RGB5us1;
  2479. fWithAlpha := tfA1RGB5us1;
  2480. fWithoutAlpha := tfX1RGB5us1;
  2481. fRGBInverted := tfX1BGR5us1;
  2482. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2483. fShift := glBitmapRec4ub(10, 5, 0, 0);
  2484. {$IFNDEF OPENGL_ES}
  2485. fOpenGLFormat := tfX1RGB5us1;
  2486. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2487. fglInternalFormat := GL_RGB5;
  2488. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2489. {$ELSE}
  2490. fOpenGLFormat := tfR5G6B5us1;
  2491. {$ENDIF}
  2492. end;
  2493. procedure TfdRGB8ub3.SetValues;
  2494. begin
  2495. inherited SetValues;
  2496. fBitsPerPixel := 24;
  2497. fFormat := tfRGB8ub3;
  2498. fWithAlpha := tfRGBA8ub4;
  2499. fWithoutAlpha := tfRGB8ub3;
  2500. fRGBInverted := tfBGR8ub3;
  2501. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2502. fShift := glBitmapRec4ub(0, 8, 16, 0);
  2503. fOpenGLFormat := tfRGB8ub3;
  2504. fglFormat := GL_RGB;
  2505. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
  2506. fglDataFormat := GL_UNSIGNED_BYTE;
  2507. end;
  2508. procedure TfdRGBX8ui1.SetValues;
  2509. begin
  2510. inherited SetValues;
  2511. fBitsPerPixel := 32;
  2512. fFormat := tfRGBX8ui1;
  2513. fWithAlpha := tfRGBA8ui1;
  2514. fWithoutAlpha := tfRGBX8ui1;
  2515. fRGBInverted := tfBGRX8ui1;
  2516. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2517. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2518. {$IFNDEF OPENGL_ES}
  2519. fOpenGLFormat := tfRGBX8ui1;
  2520. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2521. fglInternalFormat := GL_RGB8;
  2522. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2523. {$ELSE}
  2524. fOpenGLFormat := tfRGB8ub3;
  2525. {$ENDIF}
  2526. end;
  2527. procedure TfdXRGB8ui1.SetValues;
  2528. begin
  2529. inherited SetValues;
  2530. fBitsPerPixel := 32;
  2531. fFormat := tfXRGB8ui1;
  2532. fWithAlpha := tfXRGB8ui1;
  2533. fWithoutAlpha := tfXRGB8ui1;
  2534. fOpenGLFormat := tfXRGB8ui1;
  2535. fRGBInverted := tfXBGR8ui1;
  2536. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2537. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2538. {$IFNDEF OPENGL_ES}
  2539. fOpenGLFormat := tfXRGB8ui1;
  2540. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2541. fglInternalFormat := GL_RGB8;
  2542. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2543. {$ELSE}
  2544. fOpenGLFormat := tfRGB8ub3;
  2545. {$ENDIF}
  2546. end;
  2547. procedure TfdRGB10X2ui1.SetValues;
  2548. begin
  2549. inherited SetValues;
  2550. fBitsPerPixel := 32;
  2551. fFormat := tfRGB10X2ui1;
  2552. fWithAlpha := tfRGB10A2ui1;
  2553. fWithoutAlpha := tfRGB10X2ui1;
  2554. fRGBInverted := tfBGR10X2ui1;
  2555. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2556. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2557. {$IFNDEF OPENGL_ES}
  2558. fOpenGLFormat := tfRGB10X2ui1;
  2559. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2560. fglInternalFormat := GL_RGB10;
  2561. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2562. {$ELSE}
  2563. fOpenGLFormat := tfRGB16us3;
  2564. {$ENDIF}
  2565. end;
  2566. procedure TfdX2RGB10ui1.SetValues;
  2567. begin
  2568. inherited SetValues;
  2569. fBitsPerPixel := 32;
  2570. fFormat := tfX2RGB10ui1;
  2571. fWithAlpha := tfA2RGB10ui1;
  2572. fWithoutAlpha := tfX2RGB10ui1;
  2573. fRGBInverted := tfX2BGR10ui1;
  2574. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2575. fShift := glBitmapRec4ub(20, 10, 0, 0);
  2576. {$IFNDEF OPENGL_ES}
  2577. fOpenGLFormat := tfX2RGB10ui1;
  2578. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2579. fglInternalFormat := GL_RGB10;
  2580. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2581. {$ELSE}
  2582. fOpenGLFormat := tfRGB16us3;
  2583. {$ENDIF}
  2584. end;
  2585. procedure TfdRGB16us3.SetValues;
  2586. begin
  2587. inherited SetValues;
  2588. fBitsPerPixel := 48;
  2589. fFormat := tfRGB16us3;
  2590. fWithAlpha := tfRGBA16us4;
  2591. fWithoutAlpha := tfRGB16us3;
  2592. fRGBInverted := tfBGR16us3;
  2593. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2594. fShift := glBitmapRec4ub( 0, 16, 32, 0);
  2595. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2596. fOpenGLFormat := tfRGB16us3;
  2597. fglFormat := GL_RGB;
  2598. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
  2599. fglDataFormat := GL_UNSIGNED_SHORT;
  2600. {$ELSE}
  2601. fOpenGLFormat := tfRGB8ub3;
  2602. {$IFEND}
  2603. end;
  2604. procedure TfdRGBA4us1.SetValues;
  2605. begin
  2606. inherited SetValues;
  2607. fBitsPerPixel := 16;
  2608. fFormat := tfRGBA4us1;
  2609. fWithAlpha := tfRGBA4us1;
  2610. fWithoutAlpha := tfRGBX4us1;
  2611. fOpenGLFormat := tfRGBA4us1;
  2612. fRGBInverted := tfBGRA4us1;
  2613. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2614. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2615. fglFormat := GL_RGBA;
  2616. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2617. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2618. end;
  2619. procedure TfdARGB4us1.SetValues;
  2620. begin
  2621. inherited SetValues;
  2622. fBitsPerPixel := 16;
  2623. fFormat := tfARGB4us1;
  2624. fWithAlpha := tfARGB4us1;
  2625. fWithoutAlpha := tfXRGB4us1;
  2626. fRGBInverted := tfABGR4us1;
  2627. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2628. fShift := glBitmapRec4ub( 8, 4, 0, 12);
  2629. {$IFNDEF OPENGL_ES}
  2630. fOpenGLFormat := tfARGB4us1;
  2631. fglFormat := GL_BGRA;
  2632. fglInternalFormat := GL_RGBA4;
  2633. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2634. {$ELSE}
  2635. fOpenGLFormat := tfRGBA4us1;
  2636. {$ENDIF}
  2637. end;
  2638. procedure TfdRGB5A1us1.SetValues;
  2639. begin
  2640. inherited SetValues;
  2641. fBitsPerPixel := 16;
  2642. fFormat := tfRGB5A1us1;
  2643. fWithAlpha := tfRGB5A1us1;
  2644. fWithoutAlpha := tfRGB5X1us1;
  2645. fOpenGLFormat := tfRGB5A1us1;
  2646. fRGBInverted := tfBGR5A1us1;
  2647. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2648. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2649. fglFormat := GL_RGBA;
  2650. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
  2651. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2652. end;
  2653. procedure TfdA1RGB5us1.SetValues;
  2654. begin
  2655. inherited SetValues;
  2656. fBitsPerPixel := 16;
  2657. fFormat := tfA1RGB5us1;
  2658. fWithAlpha := tfA1RGB5us1;
  2659. fWithoutAlpha := tfX1RGB5us1;
  2660. fRGBInverted := tfA1BGR5us1;
  2661. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2662. fShift := glBitmapRec4ub(10, 5, 0, 15);
  2663. {$IFNDEF OPENGL_ES}
  2664. fOpenGLFormat := tfA1RGB5us1;
  2665. fglFormat := GL_BGRA;
  2666. fglInternalFormat := GL_RGB5_A1;
  2667. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2668. {$ELSE}
  2669. fOpenGLFormat := tfRGB5A1us1;
  2670. {$ENDIF}
  2671. end;
  2672. procedure TfdRGBA8ui1.SetValues;
  2673. begin
  2674. inherited SetValues;
  2675. fBitsPerPixel := 32;
  2676. fFormat := tfRGBA8ui1;
  2677. fWithAlpha := tfRGBA8ui1;
  2678. fWithoutAlpha := tfRGBX8ui1;
  2679. fRGBInverted := tfBGRA8ui1;
  2680. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2681. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2682. {$IFNDEF OPENGL_ES}
  2683. fOpenGLFormat := tfRGBA8ui1;
  2684. fglFormat := GL_RGBA;
  2685. fglInternalFormat := GL_RGBA8;
  2686. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2687. {$ELSE}
  2688. fOpenGLFormat := tfRGBA8ub4;
  2689. {$ENDIF}
  2690. end;
  2691. procedure TfdARGB8ui1.SetValues;
  2692. begin
  2693. inherited SetValues;
  2694. fBitsPerPixel := 32;
  2695. fFormat := tfARGB8ui1;
  2696. fWithAlpha := tfARGB8ui1;
  2697. fWithoutAlpha := tfXRGB8ui1;
  2698. fRGBInverted := tfABGR8ui1;
  2699. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2700. fShift := glBitmapRec4ub(16, 8, 0, 24);
  2701. {$IFNDEF OPENGL_ES}
  2702. fOpenGLFormat := tfARGB8ui1;
  2703. fglFormat := GL_BGRA;
  2704. fglInternalFormat := GL_RGBA8;
  2705. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2706. {$ELSE}
  2707. fOpenGLFormat := tfRGBA8ub4;
  2708. {$ENDIF}
  2709. end;
  2710. procedure TfdRGBA8ub4.SetValues;
  2711. begin
  2712. inherited SetValues;
  2713. fBitsPerPixel := 32;
  2714. fFormat := tfRGBA8ub4;
  2715. fWithAlpha := tfRGBA8ub4;
  2716. fWithoutAlpha := tfRGB8ub3;
  2717. fOpenGLFormat := tfRGBA8ub4;
  2718. fRGBInverted := tfBGRA8ub4;
  2719. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2720. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  2721. fglFormat := GL_RGBA;
  2722. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2723. fglDataFormat := GL_UNSIGNED_BYTE;
  2724. end;
  2725. procedure TfdRGB10A2ui1.SetValues;
  2726. begin
  2727. inherited SetValues;
  2728. fBitsPerPixel := 32;
  2729. fFormat := tfRGB10A2ui1;
  2730. fWithAlpha := tfRGB10A2ui1;
  2731. fWithoutAlpha := tfRGB10X2ui1;
  2732. fRGBInverted := tfBGR10A2ui1;
  2733. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2734. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2735. {$IFNDEF OPENGL_ES}
  2736. fOpenGLFormat := tfRGB10A2ui1;
  2737. fglFormat := GL_RGBA;
  2738. fglInternalFormat := GL_RGB10_A2;
  2739. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2740. {$ELSE}
  2741. fOpenGLFormat := tfA2RGB10ui1;
  2742. {$ENDIF}
  2743. end;
  2744. procedure TfdA2RGB10ui1.SetValues;
  2745. begin
  2746. inherited SetValues;
  2747. fBitsPerPixel := 32;
  2748. fFormat := tfA2RGB10ui1;
  2749. fWithAlpha := tfA2RGB10ui1;
  2750. fWithoutAlpha := tfX2RGB10ui1;
  2751. fRGBInverted := tfA2BGR10ui1;
  2752. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2753. fShift := glBitmapRec4ub(20, 10, 0, 30);
  2754. {$IF NOT DEFINED(OPENGL_ES)}
  2755. fOpenGLFormat := tfA2RGB10ui1;
  2756. fglFormat := GL_BGRA;
  2757. fglInternalFormat := GL_RGB10_A2;
  2758. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2759. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  2760. fOpenGLFormat := tfA2RGB10ui1;
  2761. fglFormat := GL_RGBA;
  2762. fglInternalFormat := GL_RGB10_A2;
  2763. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2764. {$ELSE}
  2765. fOpenGLFormat := tfRGBA8ui1;
  2766. {$IFEND}
  2767. end;
  2768. procedure TfdRGBA16us4.SetValues;
  2769. begin
  2770. inherited SetValues;
  2771. fBitsPerPixel := 64;
  2772. fFormat := tfRGBA16us4;
  2773. fWithAlpha := tfRGBA16us4;
  2774. fWithoutAlpha := tfRGB16us3;
  2775. fRGBInverted := tfBGRA16us4;
  2776. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2777. fShift := glBitmapRec4ub( 0, 16, 32, 48);
  2778. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2779. fOpenGLFormat := tfRGBA16us4;
  2780. fglFormat := GL_RGBA;
  2781. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
  2782. fglDataFormat := GL_UNSIGNED_SHORT;
  2783. {$ELSE}
  2784. fOpenGLFormat := tfRGBA8ub4;
  2785. {$IFEND}
  2786. end;
  2787. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2788. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2789. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2790. procedure TfdBGRX4us1.SetValues;
  2791. begin
  2792. inherited SetValues;
  2793. fBitsPerPixel := 16;
  2794. fFormat := tfBGRX4us1;
  2795. fWithAlpha := tfBGRA4us1;
  2796. fWithoutAlpha := tfBGRX4us1;
  2797. fRGBInverted := tfRGBX4us1;
  2798. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2799. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  2800. {$IFNDEF OPENGL_ES}
  2801. fOpenGLFormat := tfBGRX4us1;
  2802. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2803. fglInternalFormat := GL_RGB4;
  2804. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2805. {$ELSE}
  2806. fOpenGLFormat := tfR5G6B5us1;
  2807. {$ENDIF}
  2808. end;
  2809. procedure TfdXBGR4us1.SetValues;
  2810. begin
  2811. inherited SetValues;
  2812. fBitsPerPixel := 16;
  2813. fFormat := tfXBGR4us1;
  2814. fWithAlpha := tfABGR4us1;
  2815. fWithoutAlpha := tfXBGR4us1;
  2816. fRGBInverted := tfXRGB4us1;
  2817. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2818. fShift := glBitmapRec4ub( 0, 4, 8, 0);
  2819. {$IFNDEF OPENGL_ES}
  2820. fOpenGLFormat := tfXBGR4us1;
  2821. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2822. fglInternalFormat := GL_RGB4;
  2823. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2824. {$ELSE}
  2825. fOpenGLFormat := tfR5G6B5us1;
  2826. {$ENDIF}
  2827. end;
  2828. procedure TfdB5G6R5us1.SetValues;
  2829. begin
  2830. inherited SetValues;
  2831. fBitsPerPixel := 16;
  2832. fFormat := tfB5G6R5us1;
  2833. fWithAlpha := tfBGR5A1us1;
  2834. fWithoutAlpha := tfB5G6R5us1;
  2835. fRGBInverted := tfR5G6B5us1;
  2836. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2837. fShift := glBitmapRec4ub( 0, 5, 11, 0);
  2838. {$IFNDEF OPENGL_ES}
  2839. fOpenGLFormat := tfB5G6R5us1;
  2840. fglFormat := GL_RGB;
  2841. fglInternalFormat := GL_RGB565;
  2842. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2843. {$ELSE}
  2844. fOpenGLFormat := tfR5G6B5us1;
  2845. {$ENDIF}
  2846. end;
  2847. procedure TfdBGR5X1us1.SetValues;
  2848. begin
  2849. inherited SetValues;
  2850. fBitsPerPixel := 16;
  2851. fFormat := tfBGR5X1us1;
  2852. fWithAlpha := tfBGR5A1us1;
  2853. fWithoutAlpha := tfBGR5X1us1;
  2854. fRGBInverted := tfRGB5X1us1;
  2855. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2856. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  2857. {$IFNDEF OPENGL_ES}
  2858. fOpenGLFormat := tfBGR5X1us1;
  2859. fglFormat := GL_BGRA;
  2860. fglInternalFormat := GL_RGB5;
  2861. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2862. {$ELSE}
  2863. fOpenGLFormat := tfR5G6B5us1;
  2864. {$ENDIF}
  2865. end;
  2866. procedure TfdX1BGR5us1.SetValues;
  2867. begin
  2868. inherited SetValues;
  2869. fBitsPerPixel := 16;
  2870. fFormat := tfX1BGR5us1;
  2871. fWithAlpha := tfA1BGR5us1;
  2872. fWithoutAlpha := tfX1BGR5us1;
  2873. fRGBInverted := tfX1RGB5us1;
  2874. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2875. fShift := glBitmapRec4ub( 0, 5, 10, 0);
  2876. {$IFNDEF OPENGL_ES}
  2877. fOpenGLFormat := tfX1BGR5us1;
  2878. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2879. fglInternalFormat := GL_RGB5;
  2880. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2881. {$ELSE}
  2882. fOpenGLFormat := tfR5G6B5us1;
  2883. {$ENDIF}
  2884. end;
  2885. procedure TfdBGR8ub3.SetValues;
  2886. begin
  2887. inherited SetValues;
  2888. fBitsPerPixel := 24;
  2889. fFormat := tfBGR8ub3;
  2890. fWithAlpha := tfBGRA8ub4;
  2891. fWithoutAlpha := tfBGR8ub3;
  2892. fRGBInverted := tfRGB8ub3;
  2893. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2894. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2895. {$IFNDEF OPENGL_ES}
  2896. fOpenGLFormat := tfBGR8ub3;
  2897. fglFormat := GL_BGR;
  2898. fglInternalFormat := GL_RGB8;
  2899. fglDataFormat := GL_UNSIGNED_BYTE;
  2900. {$ELSE}
  2901. fOpenGLFormat := tfRGB8ub3;
  2902. {$ENDIF}
  2903. end;
  2904. procedure TfdBGRX8ui1.SetValues;
  2905. begin
  2906. inherited SetValues;
  2907. fBitsPerPixel := 32;
  2908. fFormat := tfBGRX8ui1;
  2909. fWithAlpha := tfBGRA8ui1;
  2910. fWithoutAlpha := tfBGRX8ui1;
  2911. fRGBInverted := tfRGBX8ui1;
  2912. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2913. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  2914. {$IFNDEF OPENGL_ES}
  2915. fOpenGLFormat := tfBGRX8ui1;
  2916. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2917. fglInternalFormat := GL_RGB8;
  2918. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2919. {$ELSE}
  2920. fOpenGLFormat := tfRGB8ub3;
  2921. {$ENDIF}
  2922. end;
  2923. procedure TfdXBGR8ui1.SetValues;
  2924. begin
  2925. inherited SetValues;
  2926. fBitsPerPixel := 32;
  2927. fFormat := tfXBGR8ui1;
  2928. fWithAlpha := tfABGR8ui1;
  2929. fWithoutAlpha := tfXBGR8ui1;
  2930. fRGBInverted := tfXRGB8ui1;
  2931. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2932. fShift := glBitmapRec4ub( 0, 8, 16, 0);
  2933. {$IFNDEF OPENGL_ES}
  2934. fOpenGLFormat := tfXBGR8ui1;
  2935. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2936. fglInternalFormat := GL_RGB8;
  2937. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2938. {$ELSE}
  2939. fOpenGLFormat := tfRGB8ub3;
  2940. {$ENDIF}
  2941. end;
  2942. procedure TfdBGR10X2ui1.SetValues;
  2943. begin
  2944. inherited SetValues;
  2945. fBitsPerPixel := 32;
  2946. fFormat := tfBGR10X2ui1;
  2947. fWithAlpha := tfBGR10A2ui1;
  2948. fWithoutAlpha := tfBGR10X2ui1;
  2949. fRGBInverted := tfRGB10X2ui1;
  2950. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2951. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  2952. {$IFNDEF OPENGL_ES}
  2953. fOpenGLFormat := tfBGR10X2ui1;
  2954. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2955. fglInternalFormat := GL_RGB10;
  2956. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2957. {$ELSE}
  2958. fOpenGLFormat := tfRGB16us3;
  2959. {$ENDIF}
  2960. end;
  2961. procedure TfdX2BGR10ui1.SetValues;
  2962. begin
  2963. inherited SetValues;
  2964. fBitsPerPixel := 32;
  2965. fFormat := tfX2BGR10ui1;
  2966. fWithAlpha := tfA2BGR10ui1;
  2967. fWithoutAlpha := tfX2BGR10ui1;
  2968. fRGBInverted := tfX2RGB10ui1;
  2969. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2970. fShift := glBitmapRec4ub( 0, 10, 20, 0);
  2971. {$IFNDEF OPENGL_ES}
  2972. fOpenGLFormat := tfX2BGR10ui1;
  2973. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2974. fglInternalFormat := GL_RGB10;
  2975. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2976. {$ELSE}
  2977. fOpenGLFormat := tfRGB16us3;
  2978. {$ENDIF}
  2979. end;
  2980. procedure TfdBGR16us3.SetValues;
  2981. begin
  2982. inherited SetValues;
  2983. fBitsPerPixel := 48;
  2984. fFormat := tfBGR16us3;
  2985. fWithAlpha := tfBGRA16us4;
  2986. fWithoutAlpha := tfBGR16us3;
  2987. fRGBInverted := tfRGB16us3;
  2988. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2989. fShift := glBitmapRec4ub(32, 16, 0, 0);
  2990. {$IFNDEF OPENGL_ES}
  2991. fOpenGLFormat := tfBGR16us3;
  2992. fglFormat := GL_BGR;
  2993. fglInternalFormat := GL_RGB16;
  2994. fglDataFormat := GL_UNSIGNED_SHORT;
  2995. {$ELSE}
  2996. fOpenGLFormat := tfRGB16us3;
  2997. {$ENDIF}
  2998. end;
  2999. procedure TfdBGRA4us1.SetValues;
  3000. begin
  3001. inherited SetValues;
  3002. fBitsPerPixel := 16;
  3003. fFormat := tfBGRA4us1;
  3004. fWithAlpha := tfBGRA4us1;
  3005. fWithoutAlpha := tfBGRX4us1;
  3006. fRGBInverted := tfRGBA4us1;
  3007. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3008. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  3009. {$IFNDEF OPENGL_ES}
  3010. fOpenGLFormat := tfBGRA4us1;
  3011. fglFormat := GL_BGRA;
  3012. fglInternalFormat := GL_RGBA4;
  3013. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3014. {$ELSE}
  3015. fOpenGLFormat := tfRGBA4us1;
  3016. {$ENDIF}
  3017. end;
  3018. procedure TfdABGR4us1.SetValues;
  3019. begin
  3020. inherited SetValues;
  3021. fBitsPerPixel := 16;
  3022. fFormat := tfABGR4us1;
  3023. fWithAlpha := tfABGR4us1;
  3024. fWithoutAlpha := tfXBGR4us1;
  3025. fRGBInverted := tfARGB4us1;
  3026. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3027. fShift := glBitmapRec4ub( 0, 4, 8, 12);
  3028. {$IFNDEF OPENGL_ES}
  3029. fOpenGLFormat := tfABGR4us1;
  3030. fglFormat := GL_RGBA;
  3031. fglInternalFormat := GL_RGBA4;
  3032. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3033. {$ELSE}
  3034. fOpenGLFormat := tfRGBA4us1;
  3035. {$ENDIF}
  3036. end;
  3037. procedure TfdBGR5A1us1.SetValues;
  3038. begin
  3039. inherited SetValues;
  3040. fBitsPerPixel := 16;
  3041. fFormat := tfBGR5A1us1;
  3042. fWithAlpha := tfBGR5A1us1;
  3043. fWithoutAlpha := tfBGR5X1us1;
  3044. fRGBInverted := tfRGB5A1us1;
  3045. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3046. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  3047. {$IFNDEF OPENGL_ES}
  3048. fOpenGLFormat := tfBGR5A1us1;
  3049. fglFormat := GL_BGRA;
  3050. fglInternalFormat := GL_RGB5_A1;
  3051. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3052. {$ELSE}
  3053. fOpenGLFormat := tfRGB5A1us1;
  3054. {$ENDIF}
  3055. end;
  3056. procedure TfdA1BGR5us1.SetValues;
  3057. begin
  3058. inherited SetValues;
  3059. fBitsPerPixel := 16;
  3060. fFormat := tfA1BGR5us1;
  3061. fWithAlpha := tfA1BGR5us1;
  3062. fWithoutAlpha := tfX1BGR5us1;
  3063. fRGBInverted := tfA1RGB5us1;
  3064. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3065. fShift := glBitmapRec4ub( 0, 5, 10, 15);
  3066. {$IFNDEF OPENGL_ES}
  3067. fOpenGLFormat := tfA1BGR5us1;
  3068. fglFormat := GL_RGBA;
  3069. fglInternalFormat := GL_RGB5_A1;
  3070. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3071. {$ELSE}
  3072. fOpenGLFormat := tfRGB5A1us1;
  3073. {$ENDIF}
  3074. end;
  3075. procedure TfdBGRA8ui1.SetValues;
  3076. begin
  3077. inherited SetValues;
  3078. fBitsPerPixel := 32;
  3079. fFormat := tfBGRA8ui1;
  3080. fWithAlpha := tfBGRA8ui1;
  3081. fWithoutAlpha := tfBGRX8ui1;
  3082. fRGBInverted := tfRGBA8ui1;
  3083. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3084. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  3085. {$IFNDEF OPENGL_ES}
  3086. fOpenGLFormat := tfBGRA8ui1;
  3087. fglFormat := GL_BGRA;
  3088. fglInternalFormat := GL_RGBA8;
  3089. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3090. {$ELSE}
  3091. fOpenGLFormat := tfRGBA8ub4;
  3092. {$ENDIF}
  3093. end;
  3094. procedure TfdABGR8ui1.SetValues;
  3095. begin
  3096. inherited SetValues;
  3097. fBitsPerPixel := 32;
  3098. fFormat := tfABGR8ui1;
  3099. fWithAlpha := tfABGR8ui1;
  3100. fWithoutAlpha := tfXBGR8ui1;
  3101. fRGBInverted := tfARGB8ui1;
  3102. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3103. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  3104. {$IFNDEF OPENGL_ES}
  3105. fOpenGLFormat := tfABGR8ui1;
  3106. fglFormat := GL_RGBA;
  3107. fglInternalFormat := GL_RGBA8;
  3108. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3109. {$ELSE}
  3110. fOpenGLFormat := tfRGBA8ub4
  3111. {$ENDIF}
  3112. end;
  3113. procedure TfdBGRA8ub4.SetValues;
  3114. begin
  3115. inherited SetValues;
  3116. fBitsPerPixel := 32;
  3117. fFormat := tfBGRA8ub4;
  3118. fWithAlpha := tfBGRA8ub4;
  3119. fWithoutAlpha := tfBGR8ub3;
  3120. fRGBInverted := tfRGBA8ub4;
  3121. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3122. fShift := glBitmapRec4ub(16, 8, 0, 24);
  3123. {$IFNDEF OPENGL_ES}
  3124. fOpenGLFormat := tfBGRA8ub4;
  3125. fglFormat := GL_BGRA;
  3126. fglInternalFormat := GL_RGBA8;
  3127. fglDataFormat := GL_UNSIGNED_BYTE;
  3128. {$ELSE}
  3129. fOpenGLFormat := tfRGBA8ub4;
  3130. {$ENDIF}
  3131. end;
  3132. procedure TfdBGR10A2ui1.SetValues;
  3133. begin
  3134. inherited SetValues;
  3135. fBitsPerPixel := 32;
  3136. fFormat := tfBGR10A2ui1;
  3137. fWithAlpha := tfBGR10A2ui1;
  3138. fWithoutAlpha := tfBGR10X2ui1;
  3139. fRGBInverted := tfRGB10A2ui1;
  3140. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3141. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  3142. {$IFNDEF OPENGL_ES}
  3143. fOpenGLFormat := tfBGR10A2ui1;
  3144. fglFormat := GL_BGRA;
  3145. fglInternalFormat := GL_RGB10_A2;
  3146. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3147. {$ELSE}
  3148. fOpenGLFormat := tfA2RGB10ui1;
  3149. {$ENDIF}
  3150. end;
  3151. procedure TfdA2BGR10ui1.SetValues;
  3152. begin
  3153. inherited SetValues;
  3154. fBitsPerPixel := 32;
  3155. fFormat := tfA2BGR10ui1;
  3156. fWithAlpha := tfA2BGR10ui1;
  3157. fWithoutAlpha := tfX2BGR10ui1;
  3158. fRGBInverted := tfA2RGB10ui1;
  3159. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3160. fShift := glBitmapRec4ub( 0, 10, 20, 30);
  3161. {$IFNDEF OPENGL_ES}
  3162. fOpenGLFormat := tfA2BGR10ui1;
  3163. fglFormat := GL_RGBA;
  3164. fglInternalFormat := GL_RGB10_A2;
  3165. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3166. {$ELSE}
  3167. fOpenGLFormat := tfA2RGB10ui1;
  3168. {$ENDIF}
  3169. end;
  3170. procedure TfdBGRA16us4.SetValues;
  3171. begin
  3172. inherited SetValues;
  3173. fBitsPerPixel := 64;
  3174. fFormat := tfBGRA16us4;
  3175. fWithAlpha := tfBGRA16us4;
  3176. fWithoutAlpha := tfBGR16us3;
  3177. fRGBInverted := tfRGBA16us4;
  3178. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3179. fShift := glBitmapRec4ub(32, 16, 0, 48);
  3180. {$IFNDEF OPENGL_ES}
  3181. fOpenGLFormat := tfBGRA16us4;
  3182. fglFormat := GL_BGRA;
  3183. fglInternalFormat := GL_RGBA16;
  3184. fglDataFormat := GL_UNSIGNED_SHORT;
  3185. {$ELSE}
  3186. fOpenGLFormat := tfRGBA16us4;
  3187. {$ENDIF}
  3188. end;
  3189. procedure TfdDepth16us1.SetValues;
  3190. begin
  3191. inherited SetValues;
  3192. fBitsPerPixel := 16;
  3193. fFormat := tfDepth16us1;
  3194. fWithoutAlpha := tfDepth16us1;
  3195. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3196. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3197. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  3198. fOpenGLFormat := tfDepth16us1;
  3199. fglFormat := GL_DEPTH_COMPONENT;
  3200. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3201. fglDataFormat := GL_UNSIGNED_SHORT;
  3202. {$IFEND}
  3203. end;
  3204. procedure TfdDepth24ui1.SetValues;
  3205. begin
  3206. inherited SetValues;
  3207. fBitsPerPixel := 32;
  3208. fFormat := tfDepth24ui1;
  3209. fWithoutAlpha := tfDepth24ui1;
  3210. fOpenGLFormat := tfDepth24ui1;
  3211. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3212. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3213. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  3214. fOpenGLFormat := tfDepth24ui1;
  3215. fglFormat := GL_DEPTH_COMPONENT;
  3216. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3217. fglDataFormat := GL_UNSIGNED_INT;
  3218. {$IFEND}
  3219. end;
  3220. procedure TfdDepth32ui1.SetValues;
  3221. begin
  3222. inherited SetValues;
  3223. fBitsPerPixel := 32;
  3224. fFormat := tfDepth32ui1;
  3225. fWithoutAlpha := tfDepth32ui1;
  3226. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3227. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3228. {$IF NOT DEFINED(OPENGL_ES)}
  3229. fOpenGLFormat := tfDepth32ui1;
  3230. fglFormat := GL_DEPTH_COMPONENT;
  3231. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3232. fglDataFormat := GL_UNSIGNED_INT;
  3233. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  3234. fOpenGLFormat := tfDepth24ui1;
  3235. {$ELSEIF DEFINED(OPENGL_ES_2_0)}
  3236. fOpenGLFormat := tfDepth16us1;
  3237. {$IFEND}
  3238. end;
  3239. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3240. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3241. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3242. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3243. begin
  3244. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3245. end;
  3246. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3247. begin
  3248. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3249. end;
  3250. procedure TfdS3tcDtx1RGBA.SetValues;
  3251. begin
  3252. inherited SetValues;
  3253. fFormat := tfS3tcDtx1RGBA;
  3254. fWithAlpha := tfS3tcDtx1RGBA;
  3255. fUncompressed := tfRGB5A1us1;
  3256. fBitsPerPixel := 4;
  3257. fIsCompressed := true;
  3258. {$IFNDEF OPENGL_ES}
  3259. fOpenGLFormat := tfS3tcDtx1RGBA;
  3260. fglFormat := GL_COMPRESSED_RGBA;
  3261. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3262. fglDataFormat := GL_UNSIGNED_BYTE;
  3263. {$ELSE}
  3264. fOpenGLFormat := fUncompressed;
  3265. {$ENDIF}
  3266. end;
  3267. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3268. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3270. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3271. begin
  3272. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3273. end;
  3274. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3275. begin
  3276. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3277. end;
  3278. procedure TfdS3tcDtx3RGBA.SetValues;
  3279. begin
  3280. inherited SetValues;
  3281. fFormat := tfS3tcDtx3RGBA;
  3282. fWithAlpha := tfS3tcDtx3RGBA;
  3283. fUncompressed := tfRGBA8ub4;
  3284. fBitsPerPixel := 8;
  3285. fIsCompressed := true;
  3286. {$IFNDEF OPENGL_ES}
  3287. fOpenGLFormat := tfS3tcDtx3RGBA;
  3288. fglFormat := GL_COMPRESSED_RGBA;
  3289. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3290. fglDataFormat := GL_UNSIGNED_BYTE;
  3291. {$ELSE}
  3292. fOpenGLFormat := fUncompressed;
  3293. {$ENDIF}
  3294. end;
  3295. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3296. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3297. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3298. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3299. begin
  3300. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3301. end;
  3302. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3303. begin
  3304. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3305. end;
  3306. procedure TfdS3tcDtx5RGBA.SetValues;
  3307. begin
  3308. inherited SetValues;
  3309. fFormat := tfS3tcDtx3RGBA;
  3310. fWithAlpha := tfS3tcDtx3RGBA;
  3311. fUncompressed := tfRGBA8ub4;
  3312. fBitsPerPixel := 8;
  3313. fIsCompressed := true;
  3314. {$IFNDEF OPENGL_ES}
  3315. fOpenGLFormat := tfS3tcDtx3RGBA;
  3316. fglFormat := GL_COMPRESSED_RGBA;
  3317. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3318. fglDataFormat := GL_UNSIGNED_BYTE;
  3319. {$ELSE}
  3320. fOpenGLFormat := fUncompressed;
  3321. {$ENDIF}
  3322. end;
  3323. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3324. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3325. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3326. function TglBitmapFormatDescriptor.GetHasRed: Boolean;
  3327. begin
  3328. result := (fPrecision.r > 0);
  3329. end;
  3330. function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
  3331. begin
  3332. result := (fPrecision.g > 0);
  3333. end;
  3334. function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
  3335. begin
  3336. result := (fPrecision.b > 0);
  3337. end;
  3338. function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
  3339. begin
  3340. result := (fPrecision.a > 0);
  3341. end;
  3342. function TglBitmapFormatDescriptor.GetHasColor: Boolean;
  3343. begin
  3344. result := HasRed or HasGreen or HasBlue;
  3345. end;
  3346. function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
  3347. begin
  3348. result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
  3349. end;
  3350. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3351. procedure TglBitmapFormatDescriptor.SetValues;
  3352. begin
  3353. fFormat := tfEmpty;
  3354. fWithAlpha := tfEmpty;
  3355. fWithoutAlpha := tfEmpty;
  3356. fOpenGLFormat := tfEmpty;
  3357. fRGBInverted := tfEmpty;
  3358. fUncompressed := tfEmpty;
  3359. fBitsPerPixel := 0;
  3360. fIsCompressed := false;
  3361. fglFormat := 0;
  3362. fglInternalFormat := 0;
  3363. fglDataFormat := 0;
  3364. FillChar(fPrecision, 0, SizeOf(fPrecision));
  3365. FillChar(fShift, 0, SizeOf(fShift));
  3366. end;
  3367. procedure TglBitmapFormatDescriptor.CalcValues;
  3368. var
  3369. i: Integer;
  3370. begin
  3371. fBytesPerPixel := fBitsPerPixel / 8;
  3372. fChannelCount := 0;
  3373. for i := 0 to 3 do begin
  3374. if (fPrecision.arr[i] > 0) then
  3375. inc(fChannelCount);
  3376. fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
  3377. fMask.arr[i] := fRange.arr[i] shl fShift.arr[i];
  3378. end;
  3379. end;
  3380. constructor TglBitmapFormatDescriptor.Create;
  3381. begin
  3382. inherited Create;
  3383. SetValues;
  3384. CalcValues;
  3385. end;
  3386. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3387. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3388. var
  3389. f: TglBitmapFormat;
  3390. begin
  3391. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3392. result := TFormatDescriptor.Get(f);
  3393. if (result.glInternalFormat = aInternalFormat) then
  3394. exit;
  3395. end;
  3396. result := TFormatDescriptor.Get(tfEmpty);
  3397. end;
  3398. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3399. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3401. class procedure TFormatDescriptor.Init;
  3402. begin
  3403. if not Assigned(FormatDescriptorCS) then
  3404. FormatDescriptorCS := TCriticalSection.Create;
  3405. end;
  3406. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3407. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3408. begin
  3409. FormatDescriptorCS.Enter;
  3410. try
  3411. result := FormatDescriptors[aFormat];
  3412. if not Assigned(result) then begin
  3413. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3414. FormatDescriptors[aFormat] := result;
  3415. end;
  3416. finally
  3417. FormatDescriptorCS.Leave;
  3418. end;
  3419. end;
  3420. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3421. class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3422. begin
  3423. result := Get(Get(aFormat).WithAlpha);
  3424. end;
  3425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3426. class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
  3427. var
  3428. ft: TglBitmapFormat;
  3429. begin
  3430. // find matching format with OpenGL support
  3431. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3432. result := Get(ft);
  3433. if (result.MaskMatch(aMask)) and
  3434. (result.glFormat <> 0) and
  3435. (result.glInternalFormat <> 0) and
  3436. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3437. then
  3438. exit;
  3439. end;
  3440. // find matching format without OpenGL Support
  3441. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3442. result := Get(ft);
  3443. if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3444. exit;
  3445. end;
  3446. result := TFormatDescriptor.Get(tfEmpty);
  3447. end;
  3448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3449. class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  3450. var
  3451. ft: TglBitmapFormat;
  3452. begin
  3453. // find matching format with OpenGL support
  3454. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3455. result := Get(ft);
  3456. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3457. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3458. (result.glFormat <> 0) and
  3459. (result.glInternalFormat <> 0) and
  3460. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3461. then
  3462. exit;
  3463. end;
  3464. // find matching format without OpenGL Support
  3465. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3466. result := Get(ft);
  3467. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3468. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3469. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3470. exit;
  3471. end;
  3472. result := TFormatDescriptor.Get(tfEmpty);
  3473. end;
  3474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3475. class procedure TFormatDescriptor.Clear;
  3476. var
  3477. f: TglBitmapFormat;
  3478. begin
  3479. FormatDescriptorCS.Enter;
  3480. try
  3481. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3482. FreeAndNil(FormatDescriptors[f]);
  3483. finally
  3484. FormatDescriptorCS.Leave;
  3485. end;
  3486. end;
  3487. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3488. class procedure TFormatDescriptor.Finalize;
  3489. begin
  3490. Clear;
  3491. FreeAndNil(FormatDescriptorCS);
  3492. end;
  3493. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3494. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3495. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3496. procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
  3497. var
  3498. i: Integer;
  3499. begin
  3500. for i := 0 to 3 do begin
  3501. fShift.arr[i] := 0;
  3502. while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin
  3503. aMask.arr[i] := aMask.arr[i] shr 1;
  3504. inc(fShift.arr[i]);
  3505. end;
  3506. fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
  3507. end;
  3508. CalcValues;
  3509. end;
  3510. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3511. procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3512. begin
  3513. fBitsPerPixel := aBBP;
  3514. fPrecision := aPrec;
  3515. fShift := aShift;
  3516. CalcValues;
  3517. end;
  3518. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3519. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3520. var
  3521. data: QWord;
  3522. begin
  3523. data :=
  3524. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3525. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3526. ((aPixel.Data.b and Range.b) shl Shift.b) or
  3527. ((aPixel.Data.a and Range.a) shl Shift.a);
  3528. case BitsPerPixel of
  3529. 8: aData^ := data;
  3530. 16: PWord(aData)^ := data;
  3531. 32: PCardinal(aData)^ := data;
  3532. 64: PQWord(aData)^ := data;
  3533. else
  3534. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3535. end;
  3536. inc(aData, Round(BytesPerPixel));
  3537. end;
  3538. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3539. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3540. var
  3541. data: QWord;
  3542. i: Integer;
  3543. begin
  3544. case BitsPerPixel of
  3545. 8: data := aData^;
  3546. 16: data := PWord(aData)^;
  3547. 32: data := PCardinal(aData)^;
  3548. 64: data := PQWord(aData)^;
  3549. else
  3550. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3551. end;
  3552. for i := 0 to 3 do
  3553. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
  3554. inc(aData, Round(BytesPerPixel));
  3555. end;
  3556. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3557. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3558. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3559. procedure TbmpColorTableFormat.SetValues;
  3560. begin
  3561. inherited SetValues;
  3562. fShift := glBitmapRec4ub(8, 8, 8, 0);
  3563. end;
  3564. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3565. procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3566. begin
  3567. fFormat := aFormat;
  3568. fBitsPerPixel := aBPP;
  3569. fPrecision := aPrec;
  3570. fShift := aShift;
  3571. CalcValues;
  3572. end;
  3573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3574. procedure TbmpColorTableFormat.CalcValues;
  3575. begin
  3576. inherited CalcValues;
  3577. end;
  3578. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3579. procedure TbmpColorTableFormat.CreateColorTable;
  3580. var
  3581. i: Integer;
  3582. begin
  3583. SetLength(fColorTable, 256);
  3584. if not HasColor then begin
  3585. // alpha
  3586. for i := 0 to High(fColorTable) do begin
  3587. fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3588. fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3589. fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3590. fColorTable[i].a := 0;
  3591. end;
  3592. end else begin
  3593. // normal
  3594. for i := 0 to High(fColorTable) do begin
  3595. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3596. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3597. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3598. fColorTable[i].a := 0;
  3599. end;
  3600. end;
  3601. end;
  3602. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3603. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3604. begin
  3605. if (BitsPerPixel <> 8) then
  3606. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3607. if not HasColor then
  3608. // alpha
  3609. aData^ := aPixel.Data.a
  3610. else
  3611. // normal
  3612. aData^ := Round(
  3613. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3614. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3615. ((aPixel.Data.b and Range.b) shl Shift.b));
  3616. inc(aData);
  3617. end;
  3618. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3619. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3620. begin
  3621. if (BitsPerPixel <> 8) then
  3622. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3623. with fColorTable[aData^] do begin
  3624. aPixel.Data.r := r;
  3625. aPixel.Data.g := g;
  3626. aPixel.Data.b := b;
  3627. aPixel.Data.a := a;
  3628. end;
  3629. inc(aData, 1);
  3630. end;
  3631. destructor TbmpColorTableFormat.Destroy;
  3632. begin
  3633. SetLength(fColorTable, 0);
  3634. inherited Destroy;
  3635. end;
  3636. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3637. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3638. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3639. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3640. var
  3641. i: Integer;
  3642. begin
  3643. for i := 0 to 3 do begin
  3644. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3645. if (aSourceFD.Range.arr[i] > 0) then
  3646. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3647. else
  3648. aPixel.Data.arr[i] := 0;
  3649. end;
  3650. end;
  3651. end;
  3652. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3653. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3654. begin
  3655. with aFuncRec do begin
  3656. if (Source.Range.r > 0) then
  3657. Dest.Data.r := Source.Data.r;
  3658. if (Source.Range.g > 0) then
  3659. Dest.Data.g := Source.Data.g;
  3660. if (Source.Range.b > 0) then
  3661. Dest.Data.b := Source.Data.b;
  3662. if (Source.Range.a > 0) then
  3663. Dest.Data.a := Source.Data.a;
  3664. end;
  3665. end;
  3666. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3667. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3668. var
  3669. i: Integer;
  3670. begin
  3671. with aFuncRec do begin
  3672. for i := 0 to 3 do
  3673. if (Source.Range.arr[i] > 0) then
  3674. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3675. end;
  3676. end;
  3677. type
  3678. TShiftData = packed record
  3679. case Integer of
  3680. 0: (r, g, b, a: SmallInt);
  3681. 1: (arr: array[0..3] of SmallInt);
  3682. end;
  3683. PShiftData = ^TShiftData;
  3684. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3685. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3686. var
  3687. i: Integer;
  3688. begin
  3689. with aFuncRec do
  3690. for i := 0 to 3 do
  3691. if (Source.Range.arr[i] > 0) then
  3692. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3693. end;
  3694. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3695. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3696. begin
  3697. with aFuncRec do begin
  3698. Dest.Data := Source.Data;
  3699. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3700. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3701. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3702. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3703. end;
  3704. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3705. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3706. end;
  3707. end;
  3708. end;
  3709. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3710. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3711. var
  3712. i: Integer;
  3713. begin
  3714. with aFuncRec do begin
  3715. for i := 0 to 3 do
  3716. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3717. end;
  3718. end;
  3719. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3720. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3721. var
  3722. Temp: Single;
  3723. begin
  3724. with FuncRec do begin
  3725. if (FuncRec.Args = nil) then begin //source has no alpha
  3726. Temp :=
  3727. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3728. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3729. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3730. Dest.Data.a := Round(Dest.Range.a * Temp);
  3731. end else
  3732. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3733. end;
  3734. end;
  3735. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3736. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3737. type
  3738. PglBitmapPixelData = ^TglBitmapPixelData;
  3739. begin
  3740. with FuncRec do begin
  3741. Dest.Data.r := Source.Data.r;
  3742. Dest.Data.g := Source.Data.g;
  3743. Dest.Data.b := Source.Data.b;
  3744. with PglBitmapPixelData(Args)^ do
  3745. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3746. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3747. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3748. Dest.Data.a := 0
  3749. else
  3750. Dest.Data.a := Dest.Range.a;
  3751. end;
  3752. end;
  3753. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3754. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3755. begin
  3756. with FuncRec do begin
  3757. Dest.Data.r := Source.Data.r;
  3758. Dest.Data.g := Source.Data.g;
  3759. Dest.Data.b := Source.Data.b;
  3760. Dest.Data.a := PCardinal(Args)^;
  3761. end;
  3762. end;
  3763. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3764. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3765. type
  3766. PRGBPix = ^TRGBPix;
  3767. TRGBPix = array [0..2] of byte;
  3768. var
  3769. Temp: Byte;
  3770. begin
  3771. while aWidth > 0 do begin
  3772. Temp := PRGBPix(aData)^[0];
  3773. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3774. PRGBPix(aData)^[2] := Temp;
  3775. if aHasAlpha then
  3776. Inc(aData, 4)
  3777. else
  3778. Inc(aData, 3);
  3779. dec(aWidth);
  3780. end;
  3781. end;
  3782. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3783. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3784. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3785. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  3786. begin
  3787. result := TFormatDescriptor.Get(Format);
  3788. end;
  3789. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3790. function TglBitmap.GetWidth: Integer;
  3791. begin
  3792. if (ffX in fDimension.Fields) then
  3793. result := fDimension.X
  3794. else
  3795. result := -1;
  3796. end;
  3797. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3798. function TglBitmap.GetHeight: Integer;
  3799. begin
  3800. if (ffY in fDimension.Fields) then
  3801. result := fDimension.Y
  3802. else
  3803. result := -1;
  3804. end;
  3805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3806. function TglBitmap.GetFileWidth: Integer;
  3807. begin
  3808. result := Max(1, Width);
  3809. end;
  3810. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3811. function TglBitmap.GetFileHeight: Integer;
  3812. begin
  3813. result := Max(1, Height);
  3814. end;
  3815. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3816. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3817. begin
  3818. if fCustomData = aValue then
  3819. exit;
  3820. fCustomData := aValue;
  3821. end;
  3822. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3823. procedure TglBitmap.SetCustomName(const aValue: String);
  3824. begin
  3825. if fCustomName = aValue then
  3826. exit;
  3827. fCustomName := aValue;
  3828. end;
  3829. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3830. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3831. begin
  3832. if fCustomNameW = aValue then
  3833. exit;
  3834. fCustomNameW := aValue;
  3835. end;
  3836. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3837. procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
  3838. begin
  3839. if fFreeDataOnDestroy = aValue then
  3840. exit;
  3841. fFreeDataOnDestroy := aValue;
  3842. end;
  3843. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3844. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3845. begin
  3846. if fDeleteTextureOnFree = aValue then
  3847. exit;
  3848. fDeleteTextureOnFree := aValue;
  3849. end;
  3850. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3851. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3852. begin
  3853. if fFormat = aValue then
  3854. exit;
  3855. if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
  3856. raise EglBitmapUnsupportedFormat.Create(Format);
  3857. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  3858. end;
  3859. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3860. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3861. begin
  3862. if fFreeDataAfterGenTexture = aValue then
  3863. exit;
  3864. fFreeDataAfterGenTexture := aValue;
  3865. end;
  3866. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3867. procedure TglBitmap.SetID(const aValue: Cardinal);
  3868. begin
  3869. if fID = aValue then
  3870. exit;
  3871. fID := aValue;
  3872. end;
  3873. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3874. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3875. begin
  3876. if fMipMap = aValue then
  3877. exit;
  3878. fMipMap := aValue;
  3879. end;
  3880. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3881. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3882. begin
  3883. if fTarget = aValue then
  3884. exit;
  3885. fTarget := aValue;
  3886. end;
  3887. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3888. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3889. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  3890. var
  3891. MaxAnisotropic: Integer;
  3892. {$IFEND}
  3893. begin
  3894. fAnisotropic := aValue;
  3895. if (ID > 0) then begin
  3896. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  3897. if GL_EXT_texture_filter_anisotropic then begin
  3898. if fAnisotropic > 0 then begin
  3899. Bind(false);
  3900. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3901. if aValue > MaxAnisotropic then
  3902. fAnisotropic := MaxAnisotropic;
  3903. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3904. end;
  3905. end else begin
  3906. fAnisotropic := 0;
  3907. end;
  3908. {$ELSE}
  3909. fAnisotropic := 0;
  3910. {$IFEND}
  3911. end;
  3912. end;
  3913. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3914. procedure TglBitmap.CreateID;
  3915. begin
  3916. if (ID <> 0) then
  3917. glDeleteTextures(1, @fID);
  3918. glGenTextures(1, @fID);
  3919. Bind(false);
  3920. end;
  3921. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3922. procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  3923. begin
  3924. // Set Up Parameters
  3925. SetWrap(fWrapS, fWrapT, fWrapR);
  3926. SetFilter(fFilterMin, fFilterMag);
  3927. SetAnisotropic(fAnisotropic);
  3928. {$IFNDEF OPENGL_ES}
  3929. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3930. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  3931. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3932. {$ENDIF}
  3933. {$IFNDEF OPENGL_ES}
  3934. // Mip Maps Generation Mode
  3935. aBuildWithGlu := false;
  3936. if (MipMap = mmMipmap) then begin
  3937. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3938. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3939. else
  3940. aBuildWithGlu := true;
  3941. end else if (MipMap = mmMipmapGlu) then
  3942. aBuildWithGlu := true;
  3943. {$ELSE}
  3944. if (MipMap = mmMipmap) then
  3945. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
  3946. {$ENDIF}
  3947. end;
  3948. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3949. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  3950. const aWidth: Integer; const aHeight: Integer);
  3951. var
  3952. s: Single;
  3953. begin
  3954. if (Data <> aData) then begin
  3955. if (Assigned(Data)) then
  3956. FreeMem(Data);
  3957. fData := aData;
  3958. end;
  3959. if not Assigned(fData) then begin
  3960. fPixelSize := 0;
  3961. fRowSize := 0;
  3962. end else begin
  3963. FillChar(fDimension, SizeOf(fDimension), 0);
  3964. if aWidth <> -1 then begin
  3965. fDimension.Fields := fDimension.Fields + [ffX];
  3966. fDimension.X := aWidth;
  3967. end;
  3968. if aHeight <> -1 then begin
  3969. fDimension.Fields := fDimension.Fields + [ffY];
  3970. fDimension.Y := aHeight;
  3971. end;
  3972. s := TFormatDescriptor.Get(aFormat).BytesPerPixel;
  3973. fFormat := aFormat;
  3974. fPixelSize := Ceil(s);
  3975. fRowSize := Ceil(s * aWidth);
  3976. end;
  3977. end;
  3978. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3979. function TglBitmap.FlipHorz: Boolean;
  3980. begin
  3981. result := false;
  3982. end;
  3983. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3984. function TglBitmap.FlipVert: Boolean;
  3985. begin
  3986. result := false;
  3987. end;
  3988. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3989. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3990. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3991. procedure TglBitmap.AfterConstruction;
  3992. begin
  3993. inherited AfterConstruction;
  3994. fID := 0;
  3995. fTarget := 0;
  3996. {$IFNDEF OPENGL_ES}
  3997. fIsResident := false;
  3998. {$ENDIF}
  3999. fMipMap := glBitmapDefaultMipmap;
  4000. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  4001. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  4002. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  4003. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  4004. {$IFNDEF OPENGL_ES}
  4005. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  4006. {$ENDIF}
  4007. end;
  4008. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4009. procedure TglBitmap.BeforeDestruction;
  4010. var
  4011. NewData: PByte;
  4012. begin
  4013. if fFreeDataOnDestroy then begin
  4014. NewData := nil;
  4015. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  4016. end;
  4017. if (fID > 0) and fDeleteTextureOnFree then
  4018. glDeleteTextures(1, @fID);
  4019. inherited BeforeDestruction;
  4020. end;
  4021. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4022. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  4023. var
  4024. TempPos: Integer;
  4025. begin
  4026. if not Assigned(aResType) then begin
  4027. TempPos := Pos('.', aResource);
  4028. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  4029. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  4030. end;
  4031. end;
  4032. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4033. procedure TglBitmap.LoadFromFile(const aFilename: String);
  4034. var
  4035. fs: TFileStream;
  4036. begin
  4037. if not FileExists(aFilename) then
  4038. raise EglBitmap.Create('file does not exist: ' + aFilename);
  4039. fFilename := aFilename;
  4040. fs := TFileStream.Create(fFilename, fmOpenRead);
  4041. try
  4042. fs.Position := 0;
  4043. LoadFromStream(fs);
  4044. finally
  4045. fs.Free;
  4046. end;
  4047. end;
  4048. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4049. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  4050. begin
  4051. {$IFDEF GLB_SUPPORT_PNG_READ}
  4052. if not LoadPNG(aStream) then
  4053. {$ENDIF}
  4054. {$IFDEF GLB_SUPPORT_JPEG_READ}
  4055. if not LoadJPEG(aStream) then
  4056. {$ENDIF}
  4057. if not LoadDDS(aStream) then
  4058. if not LoadTGA(aStream) then
  4059. if not LoadBMP(aStream) then
  4060. if not LoadRAW(aStream) then
  4061. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  4062. end;
  4063. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4064. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapSize; const aFunc: TglBitmapFunction;
  4065. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  4066. var
  4067. tmpData: PByte;
  4068. size: Integer;
  4069. begin
  4070. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4071. GetMem(tmpData, size);
  4072. try
  4073. FillChar(tmpData^, size, #$FF);
  4074. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4075. except
  4076. if Assigned(tmpData) then
  4077. FreeMem(tmpData);
  4078. raise;
  4079. end;
  4080. Convert(Self, aFunc, false, aFormat, aArgs);
  4081. end;
  4082. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4083. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  4084. var
  4085. rs: TResourceStream;
  4086. begin
  4087. PrepareResType(aResource, aResType);
  4088. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4089. try
  4090. LoadFromStream(rs);
  4091. finally
  4092. rs.Free;
  4093. end;
  4094. end;
  4095. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4096. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4097. var
  4098. rs: TResourceStream;
  4099. begin
  4100. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4101. try
  4102. LoadFromStream(rs);
  4103. finally
  4104. rs.Free;
  4105. end;
  4106. end;
  4107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4108. procedure TglBitmap.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
  4109. var
  4110. fs: TFileStream;
  4111. begin
  4112. fs := TFileStream.Create(aFileName, fmCreate);
  4113. try
  4114. fs.Position := 0;
  4115. SaveToStream(fs, aFileType);
  4116. finally
  4117. fs.Free;
  4118. end;
  4119. end;
  4120. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4121. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  4122. begin
  4123. case aFileType of
  4124. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4125. ftPNG: SavePNG(aStream);
  4126. {$ENDIF}
  4127. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  4128. ftJPEG: SaveJPEG(aStream);
  4129. {$ENDIF}
  4130. ftDDS: SaveDDS(aStream);
  4131. ftTGA: SaveTGA(aStream);
  4132. ftBMP: SaveBMP(aStream);
  4133. ftRAW: SaveRAW(aStream);
  4134. end;
  4135. end;
  4136. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4137. function TglBitmap.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  4138. begin
  4139. result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
  4140. end;
  4141. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4142. function TglBitmap.Convert(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  4143. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  4144. var
  4145. DestData, TmpData, SourceData: pByte;
  4146. TempHeight, TempWidth: Integer;
  4147. SourceFD, DestFD: TFormatDescriptor;
  4148. SourceMD, DestMD: Pointer;
  4149. FuncRec: TglBitmapFunctionRec;
  4150. begin
  4151. Assert(Assigned(Data));
  4152. Assert(Assigned(aSource));
  4153. Assert(Assigned(aSource.Data));
  4154. result := false;
  4155. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  4156. SourceFD := TFormatDescriptor.Get(aSource.Format);
  4157. DestFD := TFormatDescriptor.Get(aFormat);
  4158. if (SourceFD.IsCompressed) then
  4159. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  4160. if (DestFD.IsCompressed) then
  4161. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  4162. // inkompatible Formats so CreateTemp
  4163. if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
  4164. aCreateTemp := true;
  4165. // Values
  4166. TempHeight := Max(1, aSource.Height);
  4167. TempWidth := Max(1, aSource.Width);
  4168. FuncRec.Sender := Self;
  4169. FuncRec.Args := aArgs;
  4170. TmpData := nil;
  4171. if aCreateTemp then begin
  4172. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  4173. DestData := TmpData;
  4174. end else
  4175. DestData := Data;
  4176. try
  4177. SourceFD.PreparePixel(FuncRec.Source);
  4178. DestFD.PreparePixel (FuncRec.Dest);
  4179. SourceMD := SourceFD.CreateMappingData;
  4180. DestMD := DestFD.CreateMappingData;
  4181. FuncRec.Size := aSource.Dimension;
  4182. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4183. try
  4184. SourceData := aSource.Data;
  4185. FuncRec.Position.Y := 0;
  4186. while FuncRec.Position.Y < TempHeight do begin
  4187. FuncRec.Position.X := 0;
  4188. while FuncRec.Position.X < TempWidth do begin
  4189. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4190. aFunc(FuncRec);
  4191. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  4192. inc(FuncRec.Position.X);
  4193. end;
  4194. inc(FuncRec.Position.Y);
  4195. end;
  4196. // Updating Image or InternalFormat
  4197. if aCreateTemp then
  4198. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  4199. else if (aFormat <> fFormat) then
  4200. Format := aFormat;
  4201. result := true;
  4202. finally
  4203. SourceFD.FreeMappingData(SourceMD);
  4204. DestFD.FreeMappingData(DestMD);
  4205. end;
  4206. except
  4207. if aCreateTemp and Assigned(TmpData) then
  4208. FreeMem(TmpData);
  4209. raise;
  4210. end;
  4211. end;
  4212. end;
  4213. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4214. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4215. var
  4216. SourceFD, DestFD: TFormatDescriptor;
  4217. SourcePD, DestPD: TglBitmapPixelData;
  4218. ShiftData: TShiftData;
  4219. function DataIsIdentical: Boolean;
  4220. begin
  4221. result := SourceFD.MaskMatch(DestFD.Mask);
  4222. end;
  4223. function CanCopyDirect: Boolean;
  4224. begin
  4225. result :=
  4226. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4227. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4228. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4229. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4230. end;
  4231. function CanShift: Boolean;
  4232. begin
  4233. result :=
  4234. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4235. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4236. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4237. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4238. end;
  4239. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4240. begin
  4241. result := 0;
  4242. while (aSource > aDest) and (aSource > 0) do begin
  4243. inc(result);
  4244. aSource := aSource shr 1;
  4245. end;
  4246. end;
  4247. begin
  4248. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4249. SourceFD := TFormatDescriptor.Get(Format);
  4250. DestFD := TFormatDescriptor.Get(aFormat);
  4251. if DataIsIdentical then begin
  4252. result := true;
  4253. Format := aFormat;
  4254. exit;
  4255. end;
  4256. SourceFD.PreparePixel(SourcePD);
  4257. DestFD.PreparePixel (DestPD);
  4258. if CanCopyDirect then
  4259. result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
  4260. else if CanShift then begin
  4261. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4262. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4263. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4264. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4265. result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4266. end else
  4267. result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4268. end else
  4269. result := true;
  4270. end;
  4271. {$IFDEF GLB_SDL}
  4272. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4273. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  4274. var
  4275. Row, RowSize: Integer;
  4276. SourceData, TmpData: PByte;
  4277. TempDepth: Integer;
  4278. FormatDesc: TFormatDescriptor;
  4279. function GetRowPointer(Row: Integer): pByte;
  4280. begin
  4281. result := aSurface.pixels;
  4282. Inc(result, Row * RowSize);
  4283. end;
  4284. begin
  4285. result := false;
  4286. FormatDesc := TFormatDescriptor.Get(Format);
  4287. if FormatDesc.IsCompressed then
  4288. raise EglBitmapUnsupportedFormat.Create(Format);
  4289. if Assigned(Data) then begin
  4290. case Trunc(FormatDesc.PixelSize) of
  4291. 1: TempDepth := 8;
  4292. 2: TempDepth := 16;
  4293. 3: TempDepth := 24;
  4294. 4: TempDepth := 32;
  4295. else
  4296. raise EglBitmapUnsupportedFormat.Create(Format);
  4297. end;
  4298. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4299. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4300. SourceData := Data;
  4301. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4302. for Row := 0 to FileHeight-1 do begin
  4303. TmpData := GetRowPointer(Row);
  4304. if Assigned(TmpData) then begin
  4305. Move(SourceData^, TmpData^, RowSize);
  4306. inc(SourceData, RowSize);
  4307. end;
  4308. end;
  4309. result := true;
  4310. end;
  4311. end;
  4312. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4313. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4314. var
  4315. pSource, pData, pTempData: PByte;
  4316. Row, RowSize, TempWidth, TempHeight: Integer;
  4317. IntFormat: TglBitmapFormat;
  4318. fd: TFormatDescriptor;
  4319. Mask: TglBitmapMask;
  4320. function GetRowPointer(Row: Integer): pByte;
  4321. begin
  4322. result := aSurface^.pixels;
  4323. Inc(result, Row * RowSize);
  4324. end;
  4325. begin
  4326. result := false;
  4327. if (Assigned(aSurface)) then begin
  4328. with aSurface^.format^ do begin
  4329. Mask.r := RMask;
  4330. Mask.g := GMask;
  4331. Mask.b := BMask;
  4332. Mask.a := AMask;
  4333. IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
  4334. if (IntFormat = tfEmpty) then
  4335. raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
  4336. end;
  4337. fd := TFormatDescriptor.Get(IntFormat);
  4338. TempWidth := aSurface^.w;
  4339. TempHeight := aSurface^.h;
  4340. RowSize := fd.GetSize(TempWidth, 1);
  4341. GetMem(pData, TempHeight * RowSize);
  4342. try
  4343. pTempData := pData;
  4344. for Row := 0 to TempHeight -1 do begin
  4345. pSource := GetRowPointer(Row);
  4346. if (Assigned(pSource)) then begin
  4347. Move(pSource^, pTempData^, RowSize);
  4348. Inc(pTempData, RowSize);
  4349. end;
  4350. end;
  4351. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4352. result := true;
  4353. except
  4354. if Assigned(pData) then
  4355. FreeMem(pData);
  4356. raise;
  4357. end;
  4358. end;
  4359. end;
  4360. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4361. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4362. var
  4363. Row, Col, AlphaInterleave: Integer;
  4364. pSource, pDest: PByte;
  4365. function GetRowPointer(Row: Integer): pByte;
  4366. begin
  4367. result := aSurface.pixels;
  4368. Inc(result, Row * Width);
  4369. end;
  4370. begin
  4371. result := false;
  4372. if Assigned(Data) then begin
  4373. if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
  4374. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4375. AlphaInterleave := 0;
  4376. case Format of
  4377. tfLuminance8Alpha8ub2:
  4378. AlphaInterleave := 1;
  4379. tfBGRA8ub4, tfRGBA8ub4:
  4380. AlphaInterleave := 3;
  4381. end;
  4382. pSource := Data;
  4383. for Row := 0 to Height -1 do begin
  4384. pDest := GetRowPointer(Row);
  4385. if Assigned(pDest) then begin
  4386. for Col := 0 to Width -1 do begin
  4387. Inc(pSource, AlphaInterleave);
  4388. pDest^ := pSource^;
  4389. Inc(pDest);
  4390. Inc(pSource);
  4391. end;
  4392. end;
  4393. end;
  4394. result := true;
  4395. end;
  4396. end;
  4397. end;
  4398. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4399. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4400. var
  4401. bmp: TglBitmap2D;
  4402. begin
  4403. bmp := TglBitmap2D.Create;
  4404. try
  4405. bmp.AssignFromSurface(aSurface);
  4406. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4407. finally
  4408. bmp.Free;
  4409. end;
  4410. end;
  4411. {$ENDIF}
  4412. {$IFDEF GLB_DELPHI}
  4413. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4414. function CreateGrayPalette: HPALETTE;
  4415. var
  4416. Idx: Integer;
  4417. Pal: PLogPalette;
  4418. begin
  4419. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4420. Pal.palVersion := $300;
  4421. Pal.palNumEntries := 256;
  4422. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4423. Pal.palPalEntry[Idx].peRed := Idx;
  4424. Pal.palPalEntry[Idx].peGreen := Idx;
  4425. Pal.palPalEntry[Idx].peBlue := Idx;
  4426. Pal.palPalEntry[Idx].peFlags := 0;
  4427. end;
  4428. Result := CreatePalette(Pal^);
  4429. FreeMem(Pal);
  4430. end;
  4431. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4432. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4433. var
  4434. Row: Integer;
  4435. pSource, pData: PByte;
  4436. begin
  4437. result := false;
  4438. if Assigned(Data) then begin
  4439. if Assigned(aBitmap) then begin
  4440. aBitmap.Width := Width;
  4441. aBitmap.Height := Height;
  4442. case Format of
  4443. tfAlpha8ub1, tfLuminance8ub1: begin
  4444. aBitmap.PixelFormat := pf8bit;
  4445. aBitmap.Palette := CreateGrayPalette;
  4446. end;
  4447. tfRGB5A1us1:
  4448. aBitmap.PixelFormat := pf15bit;
  4449. tfR5G6B5us1:
  4450. aBitmap.PixelFormat := pf16bit;
  4451. tfRGB8ub3, tfBGR8ub3:
  4452. aBitmap.PixelFormat := pf24bit;
  4453. tfRGBA8ub4, tfBGRA8ub4:
  4454. aBitmap.PixelFormat := pf32bit;
  4455. else
  4456. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4457. end;
  4458. pSource := Data;
  4459. for Row := 0 to FileHeight -1 do begin
  4460. pData := aBitmap.Scanline[Row];
  4461. Move(pSource^, pData^, fRowSize);
  4462. Inc(pSource, fRowSize);
  4463. if (Format in [tfRGB8ub3, tfRGBA8ub4]) then // swap RGB(A) to BGR(A)
  4464. SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
  4465. end;
  4466. result := true;
  4467. end;
  4468. end;
  4469. end;
  4470. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4471. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4472. var
  4473. pSource, pData, pTempData: PByte;
  4474. Row, RowSize, TempWidth, TempHeight: Integer;
  4475. IntFormat: TglBitmapFormat;
  4476. begin
  4477. result := false;
  4478. if (Assigned(aBitmap)) then begin
  4479. case aBitmap.PixelFormat of
  4480. pf8bit:
  4481. IntFormat := tfLuminance8ub1;
  4482. pf15bit:
  4483. IntFormat := tfRGB5A1us1;
  4484. pf16bit:
  4485. IntFormat := tfR5G6B5us1;
  4486. pf24bit:
  4487. IntFormat := tfBGR8ub3;
  4488. pf32bit:
  4489. IntFormat := tfBGRA8ub4;
  4490. else
  4491. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4492. end;
  4493. TempWidth := aBitmap.Width;
  4494. TempHeight := aBitmap.Height;
  4495. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4496. GetMem(pData, TempHeight * RowSize);
  4497. try
  4498. pTempData := pData;
  4499. for Row := 0 to TempHeight -1 do begin
  4500. pSource := aBitmap.Scanline[Row];
  4501. if (Assigned(pSource)) then begin
  4502. Move(pSource^, pTempData^, RowSize);
  4503. Inc(pTempData, RowSize);
  4504. end;
  4505. end;
  4506. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4507. result := true;
  4508. except
  4509. if Assigned(pData) then
  4510. FreeMem(pData);
  4511. raise;
  4512. end;
  4513. end;
  4514. end;
  4515. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4516. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4517. var
  4518. Row, Col, AlphaInterleave: Integer;
  4519. pSource, pDest: PByte;
  4520. begin
  4521. result := false;
  4522. if Assigned(Data) then begin
  4523. if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
  4524. if Assigned(aBitmap) then begin
  4525. aBitmap.PixelFormat := pf8bit;
  4526. aBitmap.Palette := CreateGrayPalette;
  4527. aBitmap.Width := Width;
  4528. aBitmap.Height := Height;
  4529. case Format of
  4530. tfLuminance8Alpha8ub2:
  4531. AlphaInterleave := 1;
  4532. tfRGBA8ub4, tfBGRA8ub4:
  4533. AlphaInterleave := 3;
  4534. else
  4535. AlphaInterleave := 0;
  4536. end;
  4537. // Copy Data
  4538. pSource := Data;
  4539. for Row := 0 to Height -1 do begin
  4540. pDest := aBitmap.Scanline[Row];
  4541. if Assigned(pDest) then begin
  4542. for Col := 0 to Width -1 do begin
  4543. Inc(pSource, AlphaInterleave);
  4544. pDest^ := pSource^;
  4545. Inc(pDest);
  4546. Inc(pSource);
  4547. end;
  4548. end;
  4549. end;
  4550. result := true;
  4551. end;
  4552. end;
  4553. end;
  4554. end;
  4555. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4556. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4557. var
  4558. tex: TglBitmap2D;
  4559. begin
  4560. tex := TglBitmap2D.Create;
  4561. try
  4562. tex.AssignFromBitmap(ABitmap);
  4563. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4564. finally
  4565. tex.Free;
  4566. end;
  4567. end;
  4568. {$ENDIF}
  4569. {$IFDEF GLB_LAZARUS}
  4570. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4571. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4572. var
  4573. rid: TRawImageDescription;
  4574. FormatDesc: TFormatDescriptor;
  4575. begin
  4576. if not Assigned(Data) then
  4577. raise EglBitmap.Create('no pixel data assigned. load data before save');
  4578. result := false;
  4579. if not Assigned(aImage) or (Format = tfEmpty) then
  4580. exit;
  4581. FormatDesc := TFormatDescriptor.Get(Format);
  4582. if FormatDesc.IsCompressed then
  4583. exit;
  4584. FillChar(rid{%H-}, SizeOf(rid), 0);
  4585. if FormatDesc.IsGrayscale then
  4586. rid.Format := ricfGray
  4587. else
  4588. rid.Format := ricfRGBA;
  4589. rid.Width := Width;
  4590. rid.Height := Height;
  4591. rid.Depth := FormatDesc.BitsPerPixel;
  4592. rid.BitOrder := riboBitsInOrder;
  4593. rid.ByteOrder := riboLSBFirst;
  4594. rid.LineOrder := riloTopToBottom;
  4595. rid.LineEnd := rileTight;
  4596. rid.BitsPerPixel := FormatDesc.BitsPerPixel;
  4597. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4598. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4599. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4600. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4601. rid.RedShift := FormatDesc.Shift.r;
  4602. rid.GreenShift := FormatDesc.Shift.g;
  4603. rid.BlueShift := FormatDesc.Shift.b;
  4604. rid.AlphaShift := FormatDesc.Shift.a;
  4605. rid.MaskBitsPerPixel := 0;
  4606. rid.PaletteColorCount := 0;
  4607. aImage.DataDescription := rid;
  4608. aImage.CreateData;
  4609. if not Assigned(aImage.PixelData) then
  4610. raise EglBitmap.Create('error while creating LazIntfImage');
  4611. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4612. result := true;
  4613. end;
  4614. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4615. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4616. var
  4617. f: TglBitmapFormat;
  4618. FormatDesc: TFormatDescriptor;
  4619. ImageData: PByte;
  4620. ImageSize: Integer;
  4621. CanCopy: Boolean;
  4622. Mask: TglBitmapRec4ul;
  4623. procedure CopyConvert;
  4624. var
  4625. bfFormat: TbmpBitfieldFormat;
  4626. pSourceLine, pDestLine: PByte;
  4627. pSourceMD, pDestMD: Pointer;
  4628. Shift, Prec: TglBitmapRec4ub;
  4629. x, y: Integer;
  4630. pixel: TglBitmapPixelData;
  4631. begin
  4632. bfFormat := TbmpBitfieldFormat.Create;
  4633. with aImage.DataDescription do begin
  4634. Prec.r := RedPrec;
  4635. Prec.g := GreenPrec;
  4636. Prec.b := BluePrec;
  4637. Prec.a := AlphaPrec;
  4638. Shift.r := RedShift;
  4639. Shift.g := GreenShift;
  4640. Shift.b := BlueShift;
  4641. Shift.a := AlphaShift;
  4642. bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
  4643. end;
  4644. pSourceMD := bfFormat.CreateMappingData;
  4645. pDestMD := FormatDesc.CreateMappingData;
  4646. try
  4647. for y := 0 to aImage.Height-1 do begin
  4648. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  4649. pDestLine := ImageData + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
  4650. for x := 0 to aImage.Width-1 do begin
  4651. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  4652. FormatDesc.Map(pixel, pDestLine, pDestMD);
  4653. end;
  4654. end;
  4655. finally
  4656. FormatDesc.FreeMappingData(pDestMD);
  4657. bfFormat.FreeMappingData(pSourceMD);
  4658. bfFormat.Free;
  4659. end;
  4660. end;
  4661. begin
  4662. result := false;
  4663. if not Assigned(aImage) then
  4664. exit;
  4665. with aImage.DataDescription do begin
  4666. Mask.r := (QWord(1 shl RedPrec )-1) shl RedShift;
  4667. Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
  4668. Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
  4669. Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
  4670. end;
  4671. FormatDesc := TFormatDescriptor.GetFromMask(Mask);
  4672. f := FormatDesc.Format;
  4673. if (f = tfEmpty) then
  4674. exit;
  4675. CanCopy :=
  4676. (FormatDesc.BitsPerPixel = aImage.DataDescription.Depth) and
  4677. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  4678. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4679. ImageData := GetMem(ImageSize);
  4680. try
  4681. if CanCopy then
  4682. Move(aImage.PixelData^, ImageData^, ImageSize)
  4683. else
  4684. CopyConvert;
  4685. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4686. except
  4687. if Assigned(ImageData) then
  4688. FreeMem(ImageData);
  4689. raise;
  4690. end;
  4691. result := true;
  4692. end;
  4693. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4694. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4695. var
  4696. rid: TRawImageDescription;
  4697. FormatDesc: TFormatDescriptor;
  4698. Pixel: TglBitmapPixelData;
  4699. x, y: Integer;
  4700. srcMD: Pointer;
  4701. src, dst: PByte;
  4702. begin
  4703. result := false;
  4704. if not Assigned(aImage) or (Format = tfEmpty) then
  4705. exit;
  4706. FormatDesc := TFormatDescriptor.Get(Format);
  4707. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4708. exit;
  4709. FillChar(rid{%H-}, SizeOf(rid), 0);
  4710. rid.Format := ricfGray;
  4711. rid.Width := Width;
  4712. rid.Height := Height;
  4713. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4714. rid.BitOrder := riboBitsInOrder;
  4715. rid.ByteOrder := riboLSBFirst;
  4716. rid.LineOrder := riloTopToBottom;
  4717. rid.LineEnd := rileTight;
  4718. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4719. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4720. rid.GreenPrec := 0;
  4721. rid.BluePrec := 0;
  4722. rid.AlphaPrec := 0;
  4723. rid.RedShift := 0;
  4724. rid.GreenShift := 0;
  4725. rid.BlueShift := 0;
  4726. rid.AlphaShift := 0;
  4727. rid.MaskBitsPerPixel := 0;
  4728. rid.PaletteColorCount := 0;
  4729. aImage.DataDescription := rid;
  4730. aImage.CreateData;
  4731. srcMD := FormatDesc.CreateMappingData;
  4732. try
  4733. FormatDesc.PreparePixel(Pixel);
  4734. src := Data;
  4735. dst := aImage.PixelData;
  4736. for y := 0 to Height-1 do
  4737. for x := 0 to Width-1 do begin
  4738. FormatDesc.Unmap(src, Pixel, srcMD);
  4739. case rid.BitsPerPixel of
  4740. 8: begin
  4741. dst^ := Pixel.Data.a;
  4742. inc(dst);
  4743. end;
  4744. 16: begin
  4745. PWord(dst)^ := Pixel.Data.a;
  4746. inc(dst, 2);
  4747. end;
  4748. 24: begin
  4749. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4750. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4751. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4752. inc(dst, 3);
  4753. end;
  4754. 32: begin
  4755. PCardinal(dst)^ := Pixel.Data.a;
  4756. inc(dst, 4);
  4757. end;
  4758. else
  4759. raise EglBitmapUnsupportedFormat.Create(Format);
  4760. end;
  4761. end;
  4762. finally
  4763. FormatDesc.FreeMappingData(srcMD);
  4764. end;
  4765. result := true;
  4766. end;
  4767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4768. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4769. var
  4770. tex: TglBitmap2D;
  4771. begin
  4772. tex := TglBitmap2D.Create;
  4773. try
  4774. tex.AssignFromLazIntfImage(aImage);
  4775. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4776. finally
  4777. tex.Free;
  4778. end;
  4779. end;
  4780. {$ENDIF}
  4781. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4782. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4783. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4784. var
  4785. rs: TResourceStream;
  4786. begin
  4787. PrepareResType(aResource, aResType);
  4788. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4789. try
  4790. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4791. finally
  4792. rs.Free;
  4793. end;
  4794. end;
  4795. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4796. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4797. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4798. var
  4799. rs: TResourceStream;
  4800. begin
  4801. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4802. try
  4803. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4804. finally
  4805. rs.Free;
  4806. end;
  4807. end;
  4808. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4809. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4810. begin
  4811. if TFormatDescriptor.Get(Format).IsCompressed then
  4812. raise EglBitmapUnsupportedFormat.Create(Format);
  4813. result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4814. end;
  4815. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4816. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4817. var
  4818. FS: TFileStream;
  4819. begin
  4820. FS := TFileStream.Create(aFileName, fmOpenRead);
  4821. try
  4822. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4823. finally
  4824. FS.Free;
  4825. end;
  4826. end;
  4827. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4828. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4829. var
  4830. tex: TglBitmap2D;
  4831. begin
  4832. tex := TglBitmap2D.Create(aStream);
  4833. try
  4834. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4835. finally
  4836. tex.Free;
  4837. end;
  4838. end;
  4839. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4840. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4841. var
  4842. DestData, DestData2, SourceData: pByte;
  4843. TempHeight, TempWidth: Integer;
  4844. SourceFD, DestFD: TFormatDescriptor;
  4845. SourceMD, DestMD, DestMD2: Pointer;
  4846. FuncRec: TglBitmapFunctionRec;
  4847. begin
  4848. result := false;
  4849. Assert(Assigned(Data));
  4850. Assert(Assigned(aBitmap));
  4851. Assert(Assigned(aBitmap.Data));
  4852. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4853. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4854. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4855. DestFD := TFormatDescriptor.Get(Format);
  4856. if not Assigned(aFunc) then begin
  4857. aFunc := glBitmapAlphaFunc;
  4858. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4859. end else
  4860. FuncRec.Args := aArgs;
  4861. // Values
  4862. TempHeight := aBitmap.FileHeight;
  4863. TempWidth := aBitmap.FileWidth;
  4864. FuncRec.Sender := Self;
  4865. FuncRec.Size := Dimension;
  4866. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4867. DestData := Data;
  4868. DestData2 := Data;
  4869. SourceData := aBitmap.Data;
  4870. // Mapping
  4871. SourceFD.PreparePixel(FuncRec.Source);
  4872. DestFD.PreparePixel (FuncRec.Dest);
  4873. SourceMD := SourceFD.CreateMappingData;
  4874. DestMD := DestFD.CreateMappingData;
  4875. DestMD2 := DestFD.CreateMappingData;
  4876. try
  4877. FuncRec.Position.Y := 0;
  4878. while FuncRec.Position.Y < TempHeight do begin
  4879. FuncRec.Position.X := 0;
  4880. while FuncRec.Position.X < TempWidth do begin
  4881. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4882. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4883. aFunc(FuncRec);
  4884. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4885. inc(FuncRec.Position.X);
  4886. end;
  4887. inc(FuncRec.Position.Y);
  4888. end;
  4889. finally
  4890. SourceFD.FreeMappingData(SourceMD);
  4891. DestFD.FreeMappingData(DestMD);
  4892. DestFD.FreeMappingData(DestMD2);
  4893. end;
  4894. end;
  4895. end;
  4896. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4897. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4898. begin
  4899. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4900. end;
  4901. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4902. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4903. var
  4904. PixelData: TglBitmapPixelData;
  4905. begin
  4906. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  4907. result := AddAlphaFromColorKeyFloat(
  4908. aRed / PixelData.Range.r,
  4909. aGreen / PixelData.Range.g,
  4910. aBlue / PixelData.Range.b,
  4911. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4912. end;
  4913. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4914. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4915. var
  4916. values: array[0..2] of Single;
  4917. tmp: Cardinal;
  4918. i: Integer;
  4919. PixelData: TglBitmapPixelData;
  4920. begin
  4921. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  4922. with PixelData do begin
  4923. values[0] := aRed;
  4924. values[1] := aGreen;
  4925. values[2] := aBlue;
  4926. for i := 0 to 2 do begin
  4927. tmp := Trunc(Range.arr[i] * aDeviation);
  4928. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4929. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4930. end;
  4931. Data.a := 0;
  4932. Range.a := 0;
  4933. end;
  4934. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4935. end;
  4936. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4937. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4938. begin
  4939. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4940. end;
  4941. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4942. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4943. var
  4944. PixelData: TglBitmapPixelData;
  4945. begin
  4946. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  4947. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4948. end;
  4949. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4950. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4951. var
  4952. PixelData: TglBitmapPixelData;
  4953. begin
  4954. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  4955. with PixelData do
  4956. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4957. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4958. end;
  4959. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4960. function TglBitmap.RemoveAlpha: Boolean;
  4961. var
  4962. FormatDesc: TFormatDescriptor;
  4963. begin
  4964. result := false;
  4965. FormatDesc := TFormatDescriptor.Get(Format);
  4966. if Assigned(Data) then begin
  4967. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4968. raise EglBitmapUnsupportedFormat.Create(Format);
  4969. result := ConvertTo(FormatDesc.WithoutAlpha);
  4970. end;
  4971. end;
  4972. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4973. function TglBitmap.Clone: TglBitmap;
  4974. var
  4975. Temp: TglBitmap;
  4976. TempPtr: PByte;
  4977. Size: Integer;
  4978. begin
  4979. result := nil;
  4980. Temp := (ClassType.Create as TglBitmap);
  4981. try
  4982. // copy texture data if assigned
  4983. if Assigned(Data) then begin
  4984. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4985. GetMem(TempPtr, Size);
  4986. try
  4987. Move(Data^, TempPtr^, Size);
  4988. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4989. except
  4990. if Assigned(TempPtr) then
  4991. FreeMem(TempPtr);
  4992. raise;
  4993. end;
  4994. end else begin
  4995. TempPtr := nil;
  4996. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4997. end;
  4998. // copy properties
  4999. Temp.fID := ID;
  5000. Temp.fTarget := Target;
  5001. Temp.fFormat := Format;
  5002. Temp.fMipMap := MipMap;
  5003. Temp.fAnisotropic := Anisotropic;
  5004. Temp.fBorderColor := fBorderColor;
  5005. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  5006. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  5007. Temp.fFilterMin := fFilterMin;
  5008. Temp.fFilterMag := fFilterMag;
  5009. Temp.fWrapS := fWrapS;
  5010. Temp.fWrapT := fWrapT;
  5011. Temp.fWrapR := fWrapR;
  5012. Temp.fFilename := fFilename;
  5013. Temp.fCustomName := fCustomName;
  5014. Temp.fCustomNameW := fCustomNameW;
  5015. Temp.fCustomData := fCustomData;
  5016. result := Temp;
  5017. except
  5018. FreeAndNil(Temp);
  5019. raise;
  5020. end;
  5021. end;
  5022. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5023. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  5024. begin
  5025. if aUseRGB or aUseAlpha then
  5026. Convert(glBitmapInvertFunc, false, {%H-}Pointer(
  5027. ((Byte(aUseAlpha) and 1) shl 1) or
  5028. (Byte(aUseRGB) and 1) ));
  5029. end;
  5030. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5031. procedure TglBitmap.FreeData;
  5032. var
  5033. TempPtr: PByte;
  5034. begin
  5035. TempPtr := nil;
  5036. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  5037. end;
  5038. {$IFNDEF OPENGL_ES}
  5039. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5040. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  5041. begin
  5042. fBorderColor[0] := aRed;
  5043. fBorderColor[1] := aGreen;
  5044. fBorderColor[2] := aBlue;
  5045. fBorderColor[3] := aAlpha;
  5046. if (ID > 0) then begin
  5047. Bind(false);
  5048. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  5049. end;
  5050. end;
  5051. {$ENDIF}
  5052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5053. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  5054. const aAlpha: Byte);
  5055. begin
  5056. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  5057. end;
  5058. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5059. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  5060. var
  5061. PixelData: TglBitmapPixelData;
  5062. begin
  5063. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5064. FillWithColorFloat(
  5065. aRed / PixelData.Range.r,
  5066. aGreen / PixelData.Range.g,
  5067. aBlue / PixelData.Range.b,
  5068. aAlpha / PixelData.Range.a);
  5069. end;
  5070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5071. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  5072. var
  5073. PixelData: TglBitmapPixelData;
  5074. begin
  5075. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  5076. with PixelData do begin
  5077. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  5078. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  5079. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  5080. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  5081. end;
  5082. Convert(glBitmapFillWithColorFunc, false, @PixelData);
  5083. end;
  5084. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5085. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  5086. begin
  5087. //check MIN filter
  5088. case aMin of
  5089. GL_NEAREST:
  5090. fFilterMin := GL_NEAREST;
  5091. GL_LINEAR:
  5092. fFilterMin := GL_LINEAR;
  5093. GL_NEAREST_MIPMAP_NEAREST:
  5094. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  5095. GL_LINEAR_MIPMAP_NEAREST:
  5096. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  5097. GL_NEAREST_MIPMAP_LINEAR:
  5098. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  5099. GL_LINEAR_MIPMAP_LINEAR:
  5100. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  5101. else
  5102. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  5103. end;
  5104. //check MAG filter
  5105. case aMag of
  5106. GL_NEAREST:
  5107. fFilterMag := GL_NEAREST;
  5108. GL_LINEAR:
  5109. fFilterMag := GL_LINEAR;
  5110. else
  5111. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  5112. end;
  5113. //apply filter
  5114. if (ID > 0) then begin
  5115. Bind(false);
  5116. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  5117. if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
  5118. case fFilterMin of
  5119. GL_NEAREST, GL_LINEAR:
  5120. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5121. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  5122. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  5123. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  5124. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  5125. end;
  5126. end else
  5127. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5128. end;
  5129. end;
  5130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5131. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  5132. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  5133. begin
  5134. case aValue of
  5135. {$IFNDEF OPENGL_ES}
  5136. GL_CLAMP:
  5137. aTarget := GL_CLAMP;
  5138. {$ENDIF}
  5139. GL_REPEAT:
  5140. aTarget := GL_REPEAT;
  5141. GL_CLAMP_TO_EDGE: begin
  5142. {$IFNDEF OPENGL_ES}
  5143. if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
  5144. aTarget := GL_CLAMP
  5145. else
  5146. {$ENDIF}
  5147. aTarget := GL_CLAMP_TO_EDGE;
  5148. end;
  5149. {$IFNDEF OPENGL_ES}
  5150. GL_CLAMP_TO_BORDER: begin
  5151. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  5152. aTarget := GL_CLAMP_TO_BORDER
  5153. else
  5154. aTarget := GL_CLAMP;
  5155. end;
  5156. {$ENDIF}
  5157. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  5158. GL_MIRRORED_REPEAT: begin
  5159. {$IFNDEF OPENGL_ES}
  5160. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  5161. {$ELSE}
  5162. if GL_VERSION_2_0 then
  5163. {$ENDIF}
  5164. aTarget := GL_MIRRORED_REPEAT
  5165. else
  5166. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  5167. end;
  5168. {$IFEND}
  5169. else
  5170. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  5171. end;
  5172. end;
  5173. begin
  5174. CheckAndSetWrap(S, fWrapS);
  5175. CheckAndSetWrap(T, fWrapT);
  5176. CheckAndSetWrap(R, fWrapR);
  5177. if (ID > 0) then begin
  5178. Bind(false);
  5179. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  5180. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  5181. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  5182. {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
  5183. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  5184. {$IFEND}
  5185. end;
  5186. end;
  5187. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  5188. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5189. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  5190. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  5191. begin
  5192. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  5193. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  5194. fSwizzle[aIndex] := aValue
  5195. else
  5196. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  5197. end;
  5198. begin
  5199. {$IFNDEF OPENGL_ES}
  5200. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  5201. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  5202. {$ELSE}
  5203. if not GL_VERSION_3_0 then
  5204. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  5205. {$ENDIF}
  5206. CheckAndSetValue(r, 0);
  5207. CheckAndSetValue(g, 1);
  5208. CheckAndSetValue(b, 2);
  5209. CheckAndSetValue(a, 3);
  5210. if (ID > 0) then begin
  5211. Bind(false);
  5212. {$IFNDEF OPENGL_ES}
  5213. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  5214. {$ELSE}
  5215. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
  5216. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
  5217. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
  5218. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
  5219. {$ENDIF}
  5220. end;
  5221. end;
  5222. {$IFEND}
  5223. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5224. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  5225. begin
  5226. if aEnableTextureUnit then
  5227. glEnable(Target);
  5228. if (ID > 0) then
  5229. glBindTexture(Target, ID);
  5230. end;
  5231. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5232. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  5233. begin
  5234. if aDisableTextureUnit then
  5235. glDisable(Target);
  5236. glBindTexture(Target, 0);
  5237. end;
  5238. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5239. constructor TglBitmap.Create;
  5240. begin
  5241. if (ClassType = TglBitmap) then
  5242. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  5243. inherited Create;
  5244. fFormat := glBitmapGetDefaultFormat;
  5245. fFreeDataOnDestroy := true;
  5246. end;
  5247. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5248. constructor TglBitmap.Create(const aFileName: String);
  5249. begin
  5250. Create;
  5251. LoadFromFile(aFileName);
  5252. end;
  5253. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5254. constructor TglBitmap.Create(const aStream: TStream);
  5255. begin
  5256. Create;
  5257. LoadFromStream(aStream);
  5258. end;
  5259. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5260. constructor TglBitmap.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
  5261. var
  5262. ImageSize: Integer;
  5263. begin
  5264. Create;
  5265. if not Assigned(aData) then begin
  5266. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5267. GetMem(aData, ImageSize);
  5268. try
  5269. FillChar(aData^, ImageSize, #$FF);
  5270. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5271. except
  5272. if Assigned(aData) then
  5273. FreeMem(aData);
  5274. raise;
  5275. end;
  5276. end else begin
  5277. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5278. end;
  5279. end;
  5280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5281. constructor TglBitmap.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5282. begin
  5283. Create;
  5284. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  5285. end;
  5286. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5287. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  5288. begin
  5289. Create;
  5290. LoadFromResource(aInstance, aResource, aResType);
  5291. end;
  5292. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5293. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5294. begin
  5295. Create;
  5296. LoadFromResourceID(aInstance, aResourceID, aResType);
  5297. end;
  5298. {$IFDEF GLB_SUPPORT_PNG_READ}
  5299. {$IF DEFINED(GLB_LAZ_PNG)}
  5300. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5301. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5302. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5303. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5304. const
  5305. MAGIC_LEN = 8;
  5306. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  5307. var
  5308. reader: TLazReaderPNG;
  5309. intf: TLazIntfImage;
  5310. StreamPos: Int64;
  5311. magic: String[MAGIC_LEN];
  5312. begin
  5313. result := true;
  5314. StreamPos := aStream.Position;
  5315. SetLength(magic, MAGIC_LEN);
  5316. aStream.Read(magic[1], MAGIC_LEN);
  5317. aStream.Position := StreamPos;
  5318. if (magic <> PNG_MAGIC) then begin
  5319. result := false;
  5320. exit;
  5321. end;
  5322. intf := TLazIntfImage.Create(0, 0);
  5323. reader := TLazReaderPNG.Create;
  5324. try try
  5325. reader.UpdateDescription := true;
  5326. reader.ImageRead(aStream, intf);
  5327. AssignFromLazIntfImage(intf);
  5328. except
  5329. result := false;
  5330. aStream.Position := StreamPos;
  5331. exit;
  5332. end;
  5333. finally
  5334. reader.Free;
  5335. intf.Free;
  5336. end;
  5337. end;
  5338. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5339. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5340. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5341. var
  5342. Surface: PSDL_Surface;
  5343. RWops: PSDL_RWops;
  5344. begin
  5345. result := false;
  5346. RWops := glBitmapCreateRWops(aStream);
  5347. try
  5348. if IMG_isPNG(RWops) > 0 then begin
  5349. Surface := IMG_LoadPNG_RW(RWops);
  5350. try
  5351. AssignFromSurface(Surface);
  5352. result := true;
  5353. finally
  5354. SDL_FreeSurface(Surface);
  5355. end;
  5356. end;
  5357. finally
  5358. SDL_FreeRW(RWops);
  5359. end;
  5360. end;
  5361. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5362. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5363. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5364. begin
  5365. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5366. end;
  5367. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5368. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5369. var
  5370. StreamPos: Int64;
  5371. signature: array [0..7] of byte;
  5372. png: png_structp;
  5373. png_info: png_infop;
  5374. TempHeight, TempWidth: Integer;
  5375. Format: TglBitmapFormat;
  5376. png_data: pByte;
  5377. png_rows: array of pByte;
  5378. Row, LineSize: Integer;
  5379. begin
  5380. result := false;
  5381. if not init_libPNG then
  5382. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5383. try
  5384. // signature
  5385. StreamPos := aStream.Position;
  5386. aStream.Read(signature{%H-}, 8);
  5387. aStream.Position := StreamPos;
  5388. if png_check_sig(@signature, 8) <> 0 then begin
  5389. // png read struct
  5390. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5391. if png = nil then
  5392. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5393. // png info
  5394. png_info := png_create_info_struct(png);
  5395. if png_info = nil then begin
  5396. png_destroy_read_struct(@png, nil, nil);
  5397. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5398. end;
  5399. // set read callback
  5400. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5401. // read informations
  5402. png_read_info(png, png_info);
  5403. // size
  5404. TempHeight := png_get_image_height(png, png_info);
  5405. TempWidth := png_get_image_width(png, png_info);
  5406. // format
  5407. case png_get_color_type(png, png_info) of
  5408. PNG_COLOR_TYPE_GRAY:
  5409. Format := tfLuminance8ub1;
  5410. PNG_COLOR_TYPE_GRAY_ALPHA:
  5411. Format := tfLuminance8Alpha8us1;
  5412. PNG_COLOR_TYPE_RGB:
  5413. Format := tfRGB8ub3;
  5414. PNG_COLOR_TYPE_RGB_ALPHA:
  5415. Format := tfRGBA8ub4;
  5416. else
  5417. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5418. end;
  5419. // cut upper 8 bit from 16 bit formats
  5420. if png_get_bit_depth(png, png_info) > 8 then
  5421. png_set_strip_16(png);
  5422. // expand bitdepth smaller than 8
  5423. if png_get_bit_depth(png, png_info) < 8 then
  5424. png_set_expand(png);
  5425. // allocating mem for scanlines
  5426. LineSize := png_get_rowbytes(png, png_info);
  5427. GetMem(png_data, TempHeight * LineSize);
  5428. try
  5429. SetLength(png_rows, TempHeight);
  5430. for Row := Low(png_rows) to High(png_rows) do begin
  5431. png_rows[Row] := png_data;
  5432. Inc(png_rows[Row], Row * LineSize);
  5433. end;
  5434. // read complete image into scanlines
  5435. png_read_image(png, @png_rows[0]);
  5436. // read end
  5437. png_read_end(png, png_info);
  5438. // destroy read struct
  5439. png_destroy_read_struct(@png, @png_info, nil);
  5440. SetLength(png_rows, 0);
  5441. // set new data
  5442. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5443. result := true;
  5444. except
  5445. if Assigned(png_data) then
  5446. FreeMem(png_data);
  5447. raise;
  5448. end;
  5449. end;
  5450. finally
  5451. quit_libPNG;
  5452. end;
  5453. end;
  5454. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5455. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5456. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5457. var
  5458. StreamPos: Int64;
  5459. Png: TPNGObject;
  5460. Header: String[8];
  5461. Row, Col, PixSize, LineSize: Integer;
  5462. NewImage, pSource, pDest, pAlpha: pByte;
  5463. PngFormat: TglBitmapFormat;
  5464. FormatDesc: TFormatDescriptor;
  5465. const
  5466. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5467. begin
  5468. result := false;
  5469. StreamPos := aStream.Position;
  5470. aStream.Read(Header[0], SizeOf(Header));
  5471. aStream.Position := StreamPos;
  5472. {Test if the header matches}
  5473. if Header = PngHeader then begin
  5474. Png := TPNGObject.Create;
  5475. try
  5476. Png.LoadFromStream(aStream);
  5477. case Png.Header.ColorType of
  5478. COLOR_GRAYSCALE:
  5479. PngFormat := tfLuminance8ub1;
  5480. COLOR_GRAYSCALEALPHA:
  5481. PngFormat := tfLuminance8Alpha8us1;
  5482. COLOR_RGB:
  5483. PngFormat := tfBGR8ub3;
  5484. COLOR_RGBALPHA:
  5485. PngFormat := tfBGRA8ub4;
  5486. else
  5487. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5488. end;
  5489. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5490. PixSize := Round(FormatDesc.PixelSize);
  5491. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5492. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5493. try
  5494. pDest := NewImage;
  5495. case Png.Header.ColorType of
  5496. COLOR_RGB, COLOR_GRAYSCALE:
  5497. begin
  5498. for Row := 0 to Png.Height -1 do begin
  5499. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5500. Inc(pDest, LineSize);
  5501. end;
  5502. end;
  5503. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5504. begin
  5505. PixSize := PixSize -1;
  5506. for Row := 0 to Png.Height -1 do begin
  5507. pSource := Png.Scanline[Row];
  5508. pAlpha := pByte(Png.AlphaScanline[Row]);
  5509. for Col := 0 to Png.Width -1 do begin
  5510. Move (pSource^, pDest^, PixSize);
  5511. Inc(pSource, PixSize);
  5512. Inc(pDest, PixSize);
  5513. pDest^ := pAlpha^;
  5514. inc(pAlpha);
  5515. Inc(pDest);
  5516. end;
  5517. end;
  5518. end;
  5519. else
  5520. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5521. end;
  5522. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5523. result := true;
  5524. except
  5525. if Assigned(NewImage) then
  5526. FreeMem(NewImage);
  5527. raise;
  5528. end;
  5529. finally
  5530. Png.Free;
  5531. end;
  5532. end;
  5533. end;
  5534. {$IFEND}
  5535. {$ENDIF}
  5536. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5537. {$IFDEF GLB_LIB_PNG}
  5538. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5539. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5540. begin
  5541. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5542. end;
  5543. {$ENDIF}
  5544. {$IF DEFINED(GLB_LAZ_PNG)}
  5545. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5546. procedure TglBitmap.SavePNG(const aStream: TStream);
  5547. var
  5548. png: TPortableNetworkGraphic;
  5549. intf: TLazIntfImage;
  5550. raw: TRawImage;
  5551. begin
  5552. png := TPortableNetworkGraphic.Create;
  5553. intf := TLazIntfImage.Create(0, 0);
  5554. try
  5555. if not AssignToLazIntfImage(intf) then
  5556. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5557. intf.GetRawImage(raw);
  5558. png.LoadFromRawImage(raw, false);
  5559. png.SaveToStream(aStream);
  5560. finally
  5561. png.Free;
  5562. intf.Free;
  5563. end;
  5564. end;
  5565. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5566. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5567. procedure TglBitmap.SavePNG(const aStream: TStream);
  5568. var
  5569. png: png_structp;
  5570. png_info: png_infop;
  5571. png_rows: array of pByte;
  5572. LineSize: Integer;
  5573. ColorType: Integer;
  5574. Row: Integer;
  5575. FormatDesc: TFormatDescriptor;
  5576. begin
  5577. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5578. raise EglBitmapUnsupportedFormat.Create(Format);
  5579. if not init_libPNG then
  5580. raise Exception.Create('unable to initialize libPNG.');
  5581. try
  5582. case Format of
  5583. tfAlpha8ub1, tfLuminance8ub1:
  5584. ColorType := PNG_COLOR_TYPE_GRAY;
  5585. tfLuminance8Alpha8us1:
  5586. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5587. tfBGR8ub3, tfRGB8ub3:
  5588. ColorType := PNG_COLOR_TYPE_RGB;
  5589. tfBGRA8ub4, tfRGBA8ub4:
  5590. ColorType := PNG_COLOR_TYPE_RGBA;
  5591. else
  5592. raise EglBitmapUnsupportedFormat.Create(Format);
  5593. end;
  5594. FormatDesc := TFormatDescriptor.Get(Format);
  5595. LineSize := FormatDesc.GetSize(Width, 1);
  5596. // creating array for scanline
  5597. SetLength(png_rows, Height);
  5598. try
  5599. for Row := 0 to Height - 1 do begin
  5600. png_rows[Row] := Data;
  5601. Inc(png_rows[Row], Row * LineSize)
  5602. end;
  5603. // write struct
  5604. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5605. if png = nil then
  5606. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5607. // create png info
  5608. png_info := png_create_info_struct(png);
  5609. if png_info = nil then begin
  5610. png_destroy_write_struct(@png, nil);
  5611. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5612. end;
  5613. // set read callback
  5614. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5615. // set compression
  5616. png_set_compression_level(png, 6);
  5617. if Format in [tfBGR8ub3, tfBGRA8ub4] then
  5618. png_set_bgr(png);
  5619. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5620. png_write_info(png, png_info);
  5621. png_write_image(png, @png_rows[0]);
  5622. png_write_end(png, png_info);
  5623. png_destroy_write_struct(@png, @png_info);
  5624. finally
  5625. SetLength(png_rows, 0);
  5626. end;
  5627. finally
  5628. quit_libPNG;
  5629. end;
  5630. end;
  5631. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5632. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5633. procedure TglBitmap.SavePNG(const aStream: TStream);
  5634. var
  5635. Png: TPNGObject;
  5636. pSource, pDest: pByte;
  5637. X, Y, PixSize: Integer;
  5638. ColorType: Cardinal;
  5639. Alpha: Boolean;
  5640. pTemp: pByte;
  5641. Temp: Byte;
  5642. begin
  5643. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5644. raise EglBitmapUnsupportedFormat.Create(Format);
  5645. case Format of
  5646. tfAlpha8ub1, tfLuminance8ub1: begin
  5647. ColorType := COLOR_GRAYSCALE;
  5648. PixSize := 1;
  5649. Alpha := false;
  5650. end;
  5651. tfLuminance8Alpha8us1: begin
  5652. ColorType := COLOR_GRAYSCALEALPHA;
  5653. PixSize := 1;
  5654. Alpha := true;
  5655. end;
  5656. tfBGR8ub3, tfRGB8ub3: begin
  5657. ColorType := COLOR_RGB;
  5658. PixSize := 3;
  5659. Alpha := false;
  5660. end;
  5661. tfBGRA8ub4, tfRGBA8ub4: begin
  5662. ColorType := COLOR_RGBALPHA;
  5663. PixSize := 3;
  5664. Alpha := true
  5665. end;
  5666. else
  5667. raise EglBitmapUnsupportedFormat.Create(Format);
  5668. end;
  5669. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5670. try
  5671. // Copy ImageData
  5672. pSource := Data;
  5673. for Y := 0 to Height -1 do begin
  5674. pDest := png.ScanLine[Y];
  5675. for X := 0 to Width -1 do begin
  5676. Move(pSource^, pDest^, PixSize);
  5677. Inc(pDest, PixSize);
  5678. Inc(pSource, PixSize);
  5679. if Alpha then begin
  5680. png.AlphaScanline[Y]^[X] := pSource^;
  5681. Inc(pSource);
  5682. end;
  5683. end;
  5684. // convert RGB line to BGR
  5685. if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
  5686. pTemp := png.ScanLine[Y];
  5687. for X := 0 to Width -1 do begin
  5688. Temp := pByteArray(pTemp)^[0];
  5689. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5690. pByteArray(pTemp)^[2] := Temp;
  5691. Inc(pTemp, 3);
  5692. end;
  5693. end;
  5694. end;
  5695. // Save to Stream
  5696. Png.CompressionLevel := 6;
  5697. Png.SaveToStream(aStream);
  5698. finally
  5699. FreeAndNil(Png);
  5700. end;
  5701. end;
  5702. {$IFEND}
  5703. {$ENDIF}
  5704. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5705. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5706. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5707. {$IFDEF GLB_LIB_JPEG}
  5708. type
  5709. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5710. glBitmap_libJPEG_source_mgr = record
  5711. pub: jpeg_source_mgr;
  5712. SrcStream: TStream;
  5713. SrcBuffer: array [1..4096] of byte;
  5714. end;
  5715. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5716. glBitmap_libJPEG_dest_mgr = record
  5717. pub: jpeg_destination_mgr;
  5718. DestStream: TStream;
  5719. DestBuffer: array [1..4096] of byte;
  5720. end;
  5721. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5722. begin
  5723. //DUMMY
  5724. end;
  5725. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5726. begin
  5727. //DUMMY
  5728. end;
  5729. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5730. begin
  5731. //DUMMY
  5732. end;
  5733. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5734. begin
  5735. //DUMMY
  5736. end;
  5737. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5738. begin
  5739. //DUMMY
  5740. end;
  5741. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5742. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5743. var
  5744. src: glBitmap_libJPEG_source_mgr_ptr;
  5745. bytes: integer;
  5746. begin
  5747. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5748. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5749. if (bytes <= 0) then begin
  5750. src^.SrcBuffer[1] := $FF;
  5751. src^.SrcBuffer[2] := JPEG_EOI;
  5752. bytes := 2;
  5753. end;
  5754. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5755. src^.pub.bytes_in_buffer := bytes;
  5756. result := true;
  5757. end;
  5758. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5759. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5760. var
  5761. src: glBitmap_libJPEG_source_mgr_ptr;
  5762. begin
  5763. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5764. if num_bytes > 0 then begin
  5765. // wanted byte isn't in buffer so set stream position and read buffer
  5766. if num_bytes > src^.pub.bytes_in_buffer then begin
  5767. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5768. src^.pub.fill_input_buffer(cinfo);
  5769. end else begin
  5770. // wanted byte is in buffer so only skip
  5771. inc(src^.pub.next_input_byte, num_bytes);
  5772. dec(src^.pub.bytes_in_buffer, num_bytes);
  5773. end;
  5774. end;
  5775. end;
  5776. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5777. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5778. var
  5779. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5780. begin
  5781. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5782. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5783. // write complete buffer
  5784. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5785. // reset buffer
  5786. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5787. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5788. end;
  5789. result := true;
  5790. end;
  5791. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5792. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5793. var
  5794. Idx: Integer;
  5795. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5796. begin
  5797. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5798. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5799. // check for endblock
  5800. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5801. // write endblock
  5802. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5803. // leave
  5804. break;
  5805. end else
  5806. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5807. end;
  5808. end;
  5809. {$ENDIF}
  5810. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5811. {$IF DEFINED(GLB_LAZ_JPEG)}
  5812. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5813. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5814. const
  5815. MAGIC_LEN = 2;
  5816. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  5817. var
  5818. intf: TLazIntfImage;
  5819. reader: TFPReaderJPEG;
  5820. StreamPos: Int64;
  5821. magic: String[MAGIC_LEN];
  5822. begin
  5823. result := true;
  5824. StreamPos := aStream.Position;
  5825. SetLength(magic, MAGIC_LEN);
  5826. aStream.Read(magic[1], MAGIC_LEN);
  5827. aStream.Position := StreamPos;
  5828. if (magic <> JPEG_MAGIC) then begin
  5829. result := false;
  5830. exit;
  5831. end;
  5832. reader := TFPReaderJPEG.Create;
  5833. intf := TLazIntfImage.Create(0, 0);
  5834. try try
  5835. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  5836. reader.ImageRead(aStream, intf);
  5837. AssignFromLazIntfImage(intf);
  5838. except
  5839. result := false;
  5840. aStream.Position := StreamPos;
  5841. exit;
  5842. end;
  5843. finally
  5844. reader.Free;
  5845. intf.Free;
  5846. end;
  5847. end;
  5848. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5849. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5850. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5851. var
  5852. Surface: PSDL_Surface;
  5853. RWops: PSDL_RWops;
  5854. begin
  5855. result := false;
  5856. RWops := glBitmapCreateRWops(aStream);
  5857. try
  5858. if IMG_isJPG(RWops) > 0 then begin
  5859. Surface := IMG_LoadJPG_RW(RWops);
  5860. try
  5861. AssignFromSurface(Surface);
  5862. result := true;
  5863. finally
  5864. SDL_FreeSurface(Surface);
  5865. end;
  5866. end;
  5867. finally
  5868. SDL_FreeRW(RWops);
  5869. end;
  5870. end;
  5871. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5872. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5873. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5874. var
  5875. StreamPos: Int64;
  5876. Temp: array[0..1]of Byte;
  5877. jpeg: jpeg_decompress_struct;
  5878. jpeg_err: jpeg_error_mgr;
  5879. IntFormat: TglBitmapFormat;
  5880. pImage: pByte;
  5881. TempHeight, TempWidth: Integer;
  5882. pTemp: pByte;
  5883. Row: Integer;
  5884. FormatDesc: TFormatDescriptor;
  5885. begin
  5886. result := false;
  5887. if not init_libJPEG then
  5888. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5889. try
  5890. // reading first two bytes to test file and set cursor back to begin
  5891. StreamPos := aStream.Position;
  5892. aStream.Read({%H-}Temp[0], 2);
  5893. aStream.Position := StreamPos;
  5894. // if Bitmap then read file.
  5895. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5896. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5897. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5898. // error managment
  5899. jpeg.err := jpeg_std_error(@jpeg_err);
  5900. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5901. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5902. // decompression struct
  5903. jpeg_create_decompress(@jpeg);
  5904. // allocation space for streaming methods
  5905. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5906. // seeting up custom functions
  5907. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5908. pub.init_source := glBitmap_libJPEG_init_source;
  5909. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5910. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5911. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5912. pub.term_source := glBitmap_libJPEG_term_source;
  5913. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5914. pub.next_input_byte := nil; // until buffer loaded
  5915. SrcStream := aStream;
  5916. end;
  5917. // set global decoding state
  5918. jpeg.global_state := DSTATE_START;
  5919. // read header of jpeg
  5920. jpeg_read_header(@jpeg, false);
  5921. // setting output parameter
  5922. case jpeg.jpeg_color_space of
  5923. JCS_GRAYSCALE:
  5924. begin
  5925. jpeg.out_color_space := JCS_GRAYSCALE;
  5926. IntFormat := tfLuminance8ub1;
  5927. end;
  5928. else
  5929. jpeg.out_color_space := JCS_RGB;
  5930. IntFormat := tfRGB8ub3;
  5931. end;
  5932. // reading image
  5933. jpeg_start_decompress(@jpeg);
  5934. TempHeight := jpeg.output_height;
  5935. TempWidth := jpeg.output_width;
  5936. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5937. // creating new image
  5938. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5939. try
  5940. pTemp := pImage;
  5941. for Row := 0 to TempHeight -1 do begin
  5942. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5943. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5944. end;
  5945. // finish decompression
  5946. jpeg_finish_decompress(@jpeg);
  5947. // destroy decompression
  5948. jpeg_destroy_decompress(@jpeg);
  5949. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5950. result := true;
  5951. except
  5952. if Assigned(pImage) then
  5953. FreeMem(pImage);
  5954. raise;
  5955. end;
  5956. end;
  5957. finally
  5958. quit_libJPEG;
  5959. end;
  5960. end;
  5961. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5962. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5963. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5964. var
  5965. bmp: TBitmap;
  5966. jpg: TJPEGImage;
  5967. StreamPos: Int64;
  5968. Temp: array[0..1]of Byte;
  5969. begin
  5970. result := false;
  5971. // reading first two bytes to test file and set cursor back to begin
  5972. StreamPos := aStream.Position;
  5973. aStream.Read(Temp[0], 2);
  5974. aStream.Position := StreamPos;
  5975. // if Bitmap then read file.
  5976. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5977. bmp := TBitmap.Create;
  5978. try
  5979. jpg := TJPEGImage.Create;
  5980. try
  5981. jpg.LoadFromStream(aStream);
  5982. bmp.Assign(jpg);
  5983. result := AssignFromBitmap(bmp);
  5984. finally
  5985. jpg.Free;
  5986. end;
  5987. finally
  5988. bmp.Free;
  5989. end;
  5990. end;
  5991. end;
  5992. {$IFEND}
  5993. {$ENDIF}
  5994. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5995. {$IF DEFINED(GLB_LAZ_JPEG)}
  5996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5997. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5998. var
  5999. jpeg: TJPEGImage;
  6000. intf: TLazIntfImage;
  6001. raw: TRawImage;
  6002. begin
  6003. jpeg := TJPEGImage.Create;
  6004. intf := TLazIntfImage.Create(0, 0);
  6005. try
  6006. if not AssignToLazIntfImage(intf) then
  6007. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  6008. intf.GetRawImage(raw);
  6009. jpeg.LoadFromRawImage(raw, false);
  6010. jpeg.SaveToStream(aStream);
  6011. finally
  6012. intf.Free;
  6013. jpeg.Free;
  6014. end;
  6015. end;
  6016. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  6017. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6018. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6019. var
  6020. jpeg: jpeg_compress_struct;
  6021. jpeg_err: jpeg_error_mgr;
  6022. Row: Integer;
  6023. pTemp, pTemp2: pByte;
  6024. procedure CopyRow(pDest, pSource: pByte);
  6025. var
  6026. X: Integer;
  6027. begin
  6028. for X := 0 to Width - 1 do begin
  6029. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  6030. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  6031. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  6032. Inc(pDest, 3);
  6033. Inc(pSource, 3);
  6034. end;
  6035. end;
  6036. begin
  6037. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6038. raise EglBitmapUnsupportedFormat.Create(Format);
  6039. if not init_libJPEG then
  6040. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  6041. try
  6042. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  6043. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  6044. // error managment
  6045. jpeg.err := jpeg_std_error(@jpeg_err);
  6046. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  6047. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  6048. // compression struct
  6049. jpeg_create_compress(@jpeg);
  6050. // allocation space for streaming methods
  6051. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  6052. // seeting up custom functions
  6053. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  6054. pub.init_destination := glBitmap_libJPEG_init_destination;
  6055. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  6056. pub.term_destination := glBitmap_libJPEG_term_destination;
  6057. pub.next_output_byte := @DestBuffer[1];
  6058. pub.free_in_buffer := Length(DestBuffer);
  6059. DestStream := aStream;
  6060. end;
  6061. // very important state
  6062. jpeg.global_state := CSTATE_START;
  6063. jpeg.image_width := Width;
  6064. jpeg.image_height := Height;
  6065. case Format of
  6066. tfAlpha8ub1, tfLuminance8ub1: begin
  6067. jpeg.input_components := 1;
  6068. jpeg.in_color_space := JCS_GRAYSCALE;
  6069. end;
  6070. tfRGB8ub3, tfBGR8ub3: begin
  6071. jpeg.input_components := 3;
  6072. jpeg.in_color_space := JCS_RGB;
  6073. end;
  6074. end;
  6075. jpeg_set_defaults(@jpeg);
  6076. jpeg_set_quality(@jpeg, 95, true);
  6077. jpeg_start_compress(@jpeg, true);
  6078. pTemp := Data;
  6079. if Format = tfBGR8ub3 then
  6080. GetMem(pTemp2, fRowSize)
  6081. else
  6082. pTemp2 := pTemp;
  6083. try
  6084. for Row := 0 to jpeg.image_height -1 do begin
  6085. // prepare row
  6086. if Format = tfBGR8ub3 then
  6087. CopyRow(pTemp2, pTemp)
  6088. else
  6089. pTemp2 := pTemp;
  6090. // write row
  6091. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  6092. inc(pTemp, fRowSize);
  6093. end;
  6094. finally
  6095. // free memory
  6096. if Format = tfBGR8ub3 then
  6097. FreeMem(pTemp2);
  6098. end;
  6099. jpeg_finish_compress(@jpeg);
  6100. jpeg_destroy_compress(@jpeg);
  6101. finally
  6102. quit_libJPEG;
  6103. end;
  6104. end;
  6105. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  6106. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6107. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6108. var
  6109. Bmp: TBitmap;
  6110. Jpg: TJPEGImage;
  6111. begin
  6112. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6113. raise EglBitmapUnsupportedFormat.Create(Format);
  6114. Bmp := TBitmap.Create;
  6115. try
  6116. Jpg := TJPEGImage.Create;
  6117. try
  6118. AssignToBitmap(Bmp);
  6119. if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
  6120. Jpg.Grayscale := true;
  6121. Jpg.PixelFormat := jf8Bit;
  6122. end;
  6123. Jpg.Assign(Bmp);
  6124. Jpg.SaveToStream(aStream);
  6125. finally
  6126. FreeAndNil(Jpg);
  6127. end;
  6128. finally
  6129. FreeAndNil(Bmp);
  6130. end;
  6131. end;
  6132. {$IFEND}
  6133. {$ENDIF}
  6134. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6135. //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6136. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6137. type
  6138. RawHeader = packed record
  6139. Magic: String[5];
  6140. Version: Byte;
  6141. Width: Integer;
  6142. Height: Integer;
  6143. DataSize: Integer;
  6144. BitsPerPixel: Integer;
  6145. Precision: TglBitmapRec4ub;
  6146. Shift: TglBitmapRec4ub;
  6147. end;
  6148. function TglBitmap.LoadRAW(const aStream: TStream): Boolean;
  6149. var
  6150. header: RawHeader;
  6151. StartPos: Int64;
  6152. fd: TFormatDescriptor;
  6153. buf: PByte;
  6154. begin
  6155. result := false;
  6156. StartPos := aStream.Position;
  6157. aStream.Read(header{%H-}, SizeOf(header));
  6158. if (header.Magic <> 'glBMP') then begin
  6159. aStream.Position := StartPos;
  6160. exit;
  6161. end;
  6162. fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
  6163. if (fd.Format = tfEmpty) then
  6164. raise EglBitmapUnsupportedFormat.Create('no supported format found');
  6165. buf := GetMemory(header.DataSize);
  6166. aStream.Read(buf^, header.DataSize);
  6167. SetDataPointer(buf, fd.Format, header.Width, header.Height);
  6168. result := true;
  6169. end;
  6170. procedure TglBitmap.SaveRAW(const aStream: TStream);
  6171. var
  6172. header: RawHeader;
  6173. fd: TFormatDescriptor;
  6174. begin
  6175. fd := TFormatDescriptor.Get(Format);
  6176. header.Magic := 'glBMP';
  6177. header.Version := 1;
  6178. header.Width := Width;
  6179. header.Height := Height;
  6180. header.DataSize := fd.GetSize(fDimension);
  6181. header.BitsPerPixel := fd.BitsPerPixel;
  6182. header.Precision := fd.Precision;
  6183. header.Shift := fd.Shift;
  6184. aStream.Write(header, SizeOf(header));
  6185. aStream.Write(Data^, header.DataSize);
  6186. end;
  6187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6188. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6189. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6190. const
  6191. BMP_MAGIC = $4D42;
  6192. BMP_COMP_RGB = 0;
  6193. BMP_COMP_RLE8 = 1;
  6194. BMP_COMP_RLE4 = 2;
  6195. BMP_COMP_BITFIELDS = 3;
  6196. type
  6197. TBMPHeader = packed record
  6198. bfType: Word;
  6199. bfSize: Cardinal;
  6200. bfReserved1: Word;
  6201. bfReserved2: Word;
  6202. bfOffBits: Cardinal;
  6203. end;
  6204. TBMPInfo = packed record
  6205. biSize: Cardinal;
  6206. biWidth: Longint;
  6207. biHeight: Longint;
  6208. biPlanes: Word;
  6209. biBitCount: Word;
  6210. biCompression: Cardinal;
  6211. biSizeImage: Cardinal;
  6212. biXPelsPerMeter: Longint;
  6213. biYPelsPerMeter: Longint;
  6214. biClrUsed: Cardinal;
  6215. biClrImportant: Cardinal;
  6216. end;
  6217. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6218. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  6219. //////////////////////////////////////////////////////////////////////////////////////////////////
  6220. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
  6221. begin
  6222. result := tfEmpty;
  6223. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  6224. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  6225. //Read Compression
  6226. case aInfo.biCompression of
  6227. BMP_COMP_RLE4,
  6228. BMP_COMP_RLE8: begin
  6229. raise EglBitmap.Create('RLE compression is not supported');
  6230. end;
  6231. BMP_COMP_BITFIELDS: begin
  6232. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  6233. aStream.Read(aMask.r, SizeOf(aMask.r));
  6234. aStream.Read(aMask.g, SizeOf(aMask.g));
  6235. aStream.Read(aMask.b, SizeOf(aMask.b));
  6236. aStream.Read(aMask.a, SizeOf(aMask.a));
  6237. end else
  6238. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  6239. end;
  6240. end;
  6241. //get suitable format
  6242. case aInfo.biBitCount of
  6243. 8: result := tfLuminance8ub1;
  6244. 16: result := tfX1RGB5us1;
  6245. 24: result := tfBGR8ub3;
  6246. 32: result := tfXRGB8ui1;
  6247. end;
  6248. end;
  6249. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  6250. var
  6251. i, c: Integer;
  6252. ColorTable: TbmpColorTable;
  6253. begin
  6254. result := nil;
  6255. if (aInfo.biBitCount >= 16) then
  6256. exit;
  6257. aFormat := tfLuminance8ub1;
  6258. c := aInfo.biClrUsed;
  6259. if (c = 0) then
  6260. c := 1 shl aInfo.biBitCount;
  6261. SetLength(ColorTable, c);
  6262. for i := 0 to c-1 do begin
  6263. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  6264. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  6265. aFormat := tfRGB8ub3;
  6266. end;
  6267. result := TbmpColorTableFormat.Create;
  6268. result.BitsPerPixel := aInfo.biBitCount;
  6269. result.ColorTable := ColorTable;
  6270. result.CalcValues;
  6271. end;
  6272. //////////////////////////////////////////////////////////////////////////////////////////////////
  6273. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
  6274. var
  6275. FormatDesc: TFormatDescriptor;
  6276. begin
  6277. result := nil;
  6278. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  6279. FormatDesc := TFormatDescriptor.GetFromMask(aMask);
  6280. if (FormatDesc.Format = tfEmpty) then
  6281. exit;
  6282. aFormat := FormatDesc.Format;
  6283. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  6284. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  6285. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  6286. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  6287. result := TbmpBitfieldFormat.Create;
  6288. result.SetCustomValues(aInfo.biBitCount, aMask);
  6289. end;
  6290. end;
  6291. var
  6292. //simple types
  6293. StartPos: Int64;
  6294. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  6295. PaddingBuff: Cardinal;
  6296. LineBuf, ImageData, TmpData: PByte;
  6297. SourceMD, DestMD: Pointer;
  6298. BmpFormat: TglBitmapFormat;
  6299. //records
  6300. Mask: TglBitmapRec4ul;
  6301. Header: TBMPHeader;
  6302. Info: TBMPInfo;
  6303. //classes
  6304. SpecialFormat: TFormatDescriptor;
  6305. FormatDesc: TFormatDescriptor;
  6306. //////////////////////////////////////////////////////////////////////////////////////////////////
  6307. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  6308. var
  6309. i: Integer;
  6310. Pixel: TglBitmapPixelData;
  6311. begin
  6312. aStream.Read(aLineBuf^, rbLineSize);
  6313. SpecialFormat.PreparePixel(Pixel);
  6314. for i := 0 to Info.biWidth-1 do begin
  6315. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  6316. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  6317. FormatDesc.Map(Pixel, aData, DestMD);
  6318. end;
  6319. end;
  6320. begin
  6321. result := false;
  6322. BmpFormat := tfEmpty;
  6323. SpecialFormat := nil;
  6324. LineBuf := nil;
  6325. SourceMD := nil;
  6326. DestMD := nil;
  6327. // Header
  6328. StartPos := aStream.Position;
  6329. aStream.Read(Header{%H-}, SizeOf(Header));
  6330. if Header.bfType = BMP_MAGIC then begin
  6331. try try
  6332. BmpFormat := ReadInfo(Info, Mask);
  6333. SpecialFormat := ReadColorTable(BmpFormat, Info);
  6334. if not Assigned(SpecialFormat) then
  6335. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  6336. aStream.Position := StartPos + Header.bfOffBits;
  6337. if (BmpFormat <> tfEmpty) then begin
  6338. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  6339. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  6340. wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
  6341. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  6342. //get Memory
  6343. DestMD := FormatDesc.CreateMappingData;
  6344. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  6345. GetMem(ImageData, ImageSize);
  6346. if Assigned(SpecialFormat) then begin
  6347. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  6348. SourceMD := SpecialFormat.CreateMappingData;
  6349. end;
  6350. //read Data
  6351. try try
  6352. FillChar(ImageData^, ImageSize, $FF);
  6353. TmpData := ImageData;
  6354. if (Info.biHeight > 0) then
  6355. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  6356. for i := 0 to Abs(Info.biHeight)-1 do begin
  6357. if Assigned(SpecialFormat) then
  6358. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  6359. else
  6360. aStream.Read(TmpData^, wbLineSize); //else only read data
  6361. if (Info.biHeight > 0) then
  6362. dec(TmpData, wbLineSize)
  6363. else
  6364. inc(TmpData, wbLineSize);
  6365. aStream.Read(PaddingBuff{%H-}, Padding);
  6366. end;
  6367. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6368. result := true;
  6369. finally
  6370. if Assigned(LineBuf) then
  6371. FreeMem(LineBuf);
  6372. if Assigned(SourceMD) then
  6373. SpecialFormat.FreeMappingData(SourceMD);
  6374. FormatDesc.FreeMappingData(DestMD);
  6375. end;
  6376. except
  6377. if Assigned(ImageData) then
  6378. FreeMem(ImageData);
  6379. raise;
  6380. end;
  6381. end else
  6382. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6383. except
  6384. aStream.Position := StartPos;
  6385. raise;
  6386. end;
  6387. finally
  6388. FreeAndNil(SpecialFormat);
  6389. end;
  6390. end
  6391. else aStream.Position := StartPos;
  6392. end;
  6393. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6394. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6395. var
  6396. Header: TBMPHeader;
  6397. Info: TBMPInfo;
  6398. Converter: TFormatDescriptor;
  6399. FormatDesc: TFormatDescriptor;
  6400. SourceFD, DestFD: Pointer;
  6401. pData, srcData, dstData, ConvertBuffer: pByte;
  6402. Pixel: TglBitmapPixelData;
  6403. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6404. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6405. PaddingBuff: Cardinal;
  6406. function GetLineWidth : Integer;
  6407. begin
  6408. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6409. end;
  6410. begin
  6411. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6412. raise EglBitmapUnsupportedFormat.Create(Format);
  6413. Converter := nil;
  6414. FormatDesc := TFormatDescriptor.Get(Format);
  6415. ImageSize := FormatDesc.GetSize(Dimension);
  6416. FillChar(Header{%H-}, SizeOf(Header), 0);
  6417. Header.bfType := BMP_MAGIC;
  6418. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6419. Header.bfReserved1 := 0;
  6420. Header.bfReserved2 := 0;
  6421. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6422. FillChar(Info{%H-}, SizeOf(Info), 0);
  6423. Info.biSize := SizeOf(Info);
  6424. Info.biWidth := Width;
  6425. Info.biHeight := Height;
  6426. Info.biPlanes := 1;
  6427. Info.biCompression := BMP_COMP_RGB;
  6428. Info.biSizeImage := ImageSize;
  6429. try
  6430. case Format of
  6431. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
  6432. begin
  6433. Info.biBitCount := 8;
  6434. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6435. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6436. Converter := TbmpColorTableFormat.Create;
  6437. with (Converter as TbmpColorTableFormat) do begin
  6438. SetCustomValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift);
  6439. CreateColorTable;
  6440. end;
  6441. end;
  6442. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  6443. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  6444. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
  6445. begin
  6446. Info.biBitCount := 16;
  6447. Info.biCompression := BMP_COMP_BITFIELDS;
  6448. end;
  6449. tfBGR8ub3, tfRGB8ub3:
  6450. begin
  6451. Info.biBitCount := 24;
  6452. if (Format = tfRGB8ub3) then
  6453. Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6454. end;
  6455. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  6456. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
  6457. begin
  6458. Info.biBitCount := 32;
  6459. Info.biCompression := BMP_COMP_BITFIELDS;
  6460. end;
  6461. else
  6462. raise EglBitmapUnsupportedFormat.Create(Format);
  6463. end;
  6464. Info.biXPelsPerMeter := 2835;
  6465. Info.biYPelsPerMeter := 2835;
  6466. // prepare bitmasks
  6467. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6468. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6469. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6470. RedMask := FormatDesc.Mask.r;
  6471. GreenMask := FormatDesc.Mask.g;
  6472. BlueMask := FormatDesc.Mask.b;
  6473. AlphaMask := FormatDesc.Mask.a;
  6474. end;
  6475. // headers
  6476. aStream.Write(Header, SizeOf(Header));
  6477. aStream.Write(Info, SizeOf(Info));
  6478. // colortable
  6479. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6480. with (Converter as TbmpColorTableFormat) do
  6481. aStream.Write(ColorTable[0].b,
  6482. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6483. // bitmasks
  6484. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6485. aStream.Write(RedMask, SizeOf(Cardinal));
  6486. aStream.Write(GreenMask, SizeOf(Cardinal));
  6487. aStream.Write(BlueMask, SizeOf(Cardinal));
  6488. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6489. end;
  6490. // image data
  6491. rbLineSize := Round(Info.biWidth * FormatDesc.BytesPerPixel);
  6492. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6493. Padding := GetLineWidth - wbLineSize;
  6494. PaddingBuff := 0;
  6495. pData := Data;
  6496. inc(pData, (Height-1) * rbLineSize);
  6497. // prepare row buffer. But only for RGB because RGBA supports color masks
  6498. // so it's possible to change color within the image.
  6499. if Assigned(Converter) then begin
  6500. FormatDesc.PreparePixel(Pixel);
  6501. GetMem(ConvertBuffer, wbLineSize);
  6502. SourceFD := FormatDesc.CreateMappingData;
  6503. DestFD := Converter.CreateMappingData;
  6504. end else
  6505. ConvertBuffer := nil;
  6506. try
  6507. for LineIdx := 0 to Height - 1 do begin
  6508. // preparing row
  6509. if Assigned(Converter) then begin
  6510. srcData := pData;
  6511. dstData := ConvertBuffer;
  6512. for PixelIdx := 0 to Info.biWidth-1 do begin
  6513. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6514. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6515. Converter.Map(Pixel, dstData, DestFD);
  6516. end;
  6517. aStream.Write(ConvertBuffer^, wbLineSize);
  6518. end else begin
  6519. aStream.Write(pData^, rbLineSize);
  6520. end;
  6521. dec(pData, rbLineSize);
  6522. if (Padding > 0) then
  6523. aStream.Write(PaddingBuff, Padding);
  6524. end;
  6525. finally
  6526. // destroy row buffer
  6527. if Assigned(ConvertBuffer) then begin
  6528. FormatDesc.FreeMappingData(SourceFD);
  6529. Converter.FreeMappingData(DestFD);
  6530. FreeMem(ConvertBuffer);
  6531. end;
  6532. end;
  6533. finally
  6534. if Assigned(Converter) then
  6535. Converter.Free;
  6536. end;
  6537. end;
  6538. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6539. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6540. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6541. type
  6542. TTGAHeader = packed record
  6543. ImageID: Byte;
  6544. ColorMapType: Byte;
  6545. ImageType: Byte;
  6546. //ColorMapSpec: Array[0..4] of Byte;
  6547. ColorMapStart: Word;
  6548. ColorMapLength: Word;
  6549. ColorMapEntrySize: Byte;
  6550. OrigX: Word;
  6551. OrigY: Word;
  6552. Width: Word;
  6553. Height: Word;
  6554. Bpp: Byte;
  6555. ImageDesc: Byte;
  6556. end;
  6557. const
  6558. TGA_UNCOMPRESSED_RGB = 2;
  6559. TGA_UNCOMPRESSED_GRAY = 3;
  6560. TGA_COMPRESSED_RGB = 10;
  6561. TGA_COMPRESSED_GRAY = 11;
  6562. TGA_NONE_COLOR_TABLE = 0;
  6563. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6564. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6565. var
  6566. Header: TTGAHeader;
  6567. ImageData: System.PByte;
  6568. StartPosition: Int64;
  6569. PixelSize, LineSize: Integer;
  6570. tgaFormat: TglBitmapFormat;
  6571. FormatDesc: TFormatDescriptor;
  6572. Counter: packed record
  6573. X, Y: packed record
  6574. low, high, dir: Integer;
  6575. end;
  6576. end;
  6577. const
  6578. CACHE_SIZE = $4000;
  6579. ////////////////////////////////////////////////////////////////////////////////////////
  6580. procedure ReadUncompressed;
  6581. var
  6582. i, j: Integer;
  6583. buf, tmp1, tmp2: System.PByte;
  6584. begin
  6585. buf := nil;
  6586. if (Counter.X.dir < 0) then
  6587. GetMem(buf, LineSize);
  6588. try
  6589. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6590. tmp1 := ImageData;
  6591. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6592. if (Counter.X.dir < 0) then begin //flip X
  6593. aStream.Read(buf^, LineSize);
  6594. tmp2 := buf;
  6595. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6596. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6597. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6598. tmp1^ := tmp2^;
  6599. inc(tmp1);
  6600. inc(tmp2);
  6601. end;
  6602. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6603. end;
  6604. end else
  6605. aStream.Read(tmp1^, LineSize);
  6606. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6607. end;
  6608. finally
  6609. if Assigned(buf) then
  6610. FreeMem(buf);
  6611. end;
  6612. end;
  6613. ////////////////////////////////////////////////////////////////////////////////////////
  6614. procedure ReadCompressed;
  6615. /////////////////////////////////////////////////////////////////
  6616. var
  6617. TmpData: System.PByte;
  6618. LinePixelsRead: Integer;
  6619. procedure CheckLine;
  6620. begin
  6621. if (LinePixelsRead >= Header.Width) then begin
  6622. LinePixelsRead := 0;
  6623. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6624. TmpData := ImageData;
  6625. inc(TmpData, Counter.Y.low * LineSize); //set line
  6626. if (Counter.X.dir < 0) then //if x flipped then
  6627. inc(TmpData, LineSize - PixelSize); //set last pixel
  6628. end;
  6629. end;
  6630. /////////////////////////////////////////////////////////////////
  6631. var
  6632. Cache: PByte;
  6633. CacheSize, CachePos: Integer;
  6634. procedure CachedRead(out Buffer; Count: Integer);
  6635. var
  6636. BytesRead: Integer;
  6637. begin
  6638. if (CachePos + Count > CacheSize) then begin
  6639. //if buffer overflow save non read bytes
  6640. BytesRead := 0;
  6641. if (CacheSize - CachePos > 0) then begin
  6642. BytesRead := CacheSize - CachePos;
  6643. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6644. inc(CachePos, BytesRead);
  6645. end;
  6646. //load cache from file
  6647. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6648. aStream.Read(Cache^, CacheSize);
  6649. CachePos := 0;
  6650. //read rest of requested bytes
  6651. if (Count - BytesRead > 0) then begin
  6652. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6653. inc(CachePos, Count - BytesRead);
  6654. end;
  6655. end else begin
  6656. //if no buffer overflow just read the data
  6657. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6658. inc(CachePos, Count);
  6659. end;
  6660. end;
  6661. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6662. begin
  6663. case PixelSize of
  6664. 1: begin
  6665. aBuffer^ := aData^;
  6666. inc(aBuffer, Counter.X.dir);
  6667. end;
  6668. 2: begin
  6669. PWord(aBuffer)^ := PWord(aData)^;
  6670. inc(aBuffer, 2 * Counter.X.dir);
  6671. end;
  6672. 3: begin
  6673. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6674. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6675. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6676. inc(aBuffer, 3 * Counter.X.dir);
  6677. end;
  6678. 4: begin
  6679. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6680. inc(aBuffer, 4 * Counter.X.dir);
  6681. end;
  6682. end;
  6683. end;
  6684. var
  6685. TotalPixelsToRead, TotalPixelsRead: Integer;
  6686. Temp: Byte;
  6687. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6688. PixelRepeat: Boolean;
  6689. PixelsToRead, PixelCount: Integer;
  6690. begin
  6691. CacheSize := 0;
  6692. CachePos := 0;
  6693. TotalPixelsToRead := Header.Width * Header.Height;
  6694. TotalPixelsRead := 0;
  6695. LinePixelsRead := 0;
  6696. GetMem(Cache, CACHE_SIZE);
  6697. try
  6698. TmpData := ImageData;
  6699. inc(TmpData, Counter.Y.low * LineSize); //set line
  6700. if (Counter.X.dir < 0) then //if x flipped then
  6701. inc(TmpData, LineSize - PixelSize); //set last pixel
  6702. repeat
  6703. //read CommandByte
  6704. CachedRead(Temp, 1);
  6705. PixelRepeat := (Temp and $80) > 0;
  6706. PixelsToRead := (Temp and $7F) + 1;
  6707. inc(TotalPixelsRead, PixelsToRead);
  6708. if PixelRepeat then
  6709. CachedRead(buf[0], PixelSize);
  6710. while (PixelsToRead > 0) do begin
  6711. CheckLine;
  6712. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6713. while (PixelCount > 0) do begin
  6714. if not PixelRepeat then
  6715. CachedRead(buf[0], PixelSize);
  6716. PixelToBuffer(@buf[0], TmpData);
  6717. inc(LinePixelsRead);
  6718. dec(PixelsToRead);
  6719. dec(PixelCount);
  6720. end;
  6721. end;
  6722. until (TotalPixelsRead >= TotalPixelsToRead);
  6723. finally
  6724. FreeMem(Cache);
  6725. end;
  6726. end;
  6727. function IsGrayFormat: Boolean;
  6728. begin
  6729. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6730. end;
  6731. begin
  6732. result := false;
  6733. // reading header to test file and set cursor back to begin
  6734. StartPosition := aStream.Position;
  6735. aStream.Read(Header{%H-}, SizeOf(Header));
  6736. // no colormapped files
  6737. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6738. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6739. begin
  6740. try
  6741. if Header.ImageID <> 0 then // skip image ID
  6742. aStream.Position := aStream.Position + Header.ImageID;
  6743. tgaFormat := tfEmpty;
  6744. case Header.Bpp of
  6745. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6746. 0: tgaFormat := tfLuminance8ub1;
  6747. 8: tgaFormat := tfAlpha8ub1;
  6748. end;
  6749. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6750. 0: tgaFormat := tfLuminance16us1;
  6751. 8: tgaFormat := tfLuminance8Alpha8ub2;
  6752. end else case (Header.ImageDesc and $F) of
  6753. 0: tgaFormat := tfX1RGB5us1;
  6754. 1: tgaFormat := tfA1RGB5us1;
  6755. 4: tgaFormat := tfARGB4us1;
  6756. end;
  6757. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6758. 0: tgaFormat := tfBGR8ub3;
  6759. end;
  6760. 32: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6761. 0: tgaFormat := tfDepth32ui1;
  6762. end else case (Header.ImageDesc and $F) of
  6763. 0: tgaFormat := tfX2RGB10ui1;
  6764. 2: tgaFormat := tfA2RGB10ui1;
  6765. 8: tgaFormat := tfARGB8ui1;
  6766. end;
  6767. end;
  6768. if (tgaFormat = tfEmpty) then
  6769. raise EglBitmap.Create('LoadTga - unsupported format');
  6770. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6771. PixelSize := FormatDesc.GetSize(1, 1);
  6772. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6773. GetMem(ImageData, LineSize * Header.Height);
  6774. try
  6775. //column direction
  6776. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6777. Counter.X.low := Header.Height-1;;
  6778. Counter.X.high := 0;
  6779. Counter.X.dir := -1;
  6780. end else begin
  6781. Counter.X.low := 0;
  6782. Counter.X.high := Header.Height-1;
  6783. Counter.X.dir := 1;
  6784. end;
  6785. // Row direction
  6786. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6787. Counter.Y.low := 0;
  6788. Counter.Y.high := Header.Height-1;
  6789. Counter.Y.dir := 1;
  6790. end else begin
  6791. Counter.Y.low := Header.Height-1;;
  6792. Counter.Y.high := 0;
  6793. Counter.Y.dir := -1;
  6794. end;
  6795. // Read Image
  6796. case Header.ImageType of
  6797. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6798. ReadUncompressed;
  6799. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6800. ReadCompressed;
  6801. end;
  6802. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6803. result := true;
  6804. except
  6805. if Assigned(ImageData) then
  6806. FreeMem(ImageData);
  6807. raise;
  6808. end;
  6809. finally
  6810. aStream.Position := StartPosition;
  6811. end;
  6812. end
  6813. else aStream.Position := StartPosition;
  6814. end;
  6815. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6816. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6817. var
  6818. Header: TTGAHeader;
  6819. Size: Integer;
  6820. FormatDesc: TFormatDescriptor;
  6821. begin
  6822. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6823. raise EglBitmapUnsupportedFormat.Create(Format);
  6824. //prepare header
  6825. FormatDesc := TFormatDescriptor.Get(Format);
  6826. FillChar(Header{%H-}, SizeOf(Header), 0);
  6827. Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
  6828. Header.Bpp := FormatDesc.BitsPerPixel;
  6829. Header.Width := Width;
  6830. Header.Height := Height;
  6831. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6832. if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
  6833. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6834. else
  6835. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6836. aStream.Write(Header, SizeOf(Header));
  6837. // write Data
  6838. Size := FormatDesc.GetSize(Dimension);
  6839. aStream.Write(Data^, Size);
  6840. end;
  6841. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6842. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6843. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6844. const
  6845. DDS_MAGIC: Cardinal = $20534444;
  6846. // DDS_header.dwFlags
  6847. DDSD_CAPS = $00000001;
  6848. DDSD_HEIGHT = $00000002;
  6849. DDSD_WIDTH = $00000004;
  6850. DDSD_PIXELFORMAT = $00001000;
  6851. // DDS_header.sPixelFormat.dwFlags
  6852. DDPF_ALPHAPIXELS = $00000001;
  6853. DDPF_ALPHA = $00000002;
  6854. DDPF_FOURCC = $00000004;
  6855. DDPF_RGB = $00000040;
  6856. DDPF_LUMINANCE = $00020000;
  6857. // DDS_header.sCaps.dwCaps1
  6858. DDSCAPS_TEXTURE = $00001000;
  6859. // DDS_header.sCaps.dwCaps2
  6860. DDSCAPS2_CUBEMAP = $00000200;
  6861. D3DFMT_DXT1 = $31545844;
  6862. D3DFMT_DXT3 = $33545844;
  6863. D3DFMT_DXT5 = $35545844;
  6864. type
  6865. TDDSPixelFormat = packed record
  6866. dwSize: Cardinal;
  6867. dwFlags: Cardinal;
  6868. dwFourCC: Cardinal;
  6869. dwRGBBitCount: Cardinal;
  6870. dwRBitMask: Cardinal;
  6871. dwGBitMask: Cardinal;
  6872. dwBBitMask: Cardinal;
  6873. dwABitMask: Cardinal;
  6874. end;
  6875. TDDSCaps = packed record
  6876. dwCaps1: Cardinal;
  6877. dwCaps2: Cardinal;
  6878. dwDDSX: Cardinal;
  6879. dwReserved: Cardinal;
  6880. end;
  6881. TDDSHeader = packed record
  6882. dwSize: Cardinal;
  6883. dwFlags: Cardinal;
  6884. dwHeight: Cardinal;
  6885. dwWidth: Cardinal;
  6886. dwPitchOrLinearSize: Cardinal;
  6887. dwDepth: Cardinal;
  6888. dwMipMapCount: Cardinal;
  6889. dwReserved: array[0..10] of Cardinal;
  6890. PixelFormat: TDDSPixelFormat;
  6891. Caps: TDDSCaps;
  6892. dwReserved2: Cardinal;
  6893. end;
  6894. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6895. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6896. var
  6897. Header: TDDSHeader;
  6898. Converter: TbmpBitfieldFormat;
  6899. function GetDDSFormat: TglBitmapFormat;
  6900. var
  6901. fd: TFormatDescriptor;
  6902. i: Integer;
  6903. Mask: TglBitmapRec4ul;
  6904. Range: TglBitmapRec4ui;
  6905. match: Boolean;
  6906. begin
  6907. result := tfEmpty;
  6908. with Header.PixelFormat do begin
  6909. // Compresses
  6910. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6911. case Header.PixelFormat.dwFourCC of
  6912. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6913. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6914. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6915. end;
  6916. end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
  6917. // prepare masks
  6918. if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
  6919. Mask.r := dwRBitMask;
  6920. Mask.g := dwGBitMask;
  6921. Mask.b := dwBBitMask;
  6922. end else begin
  6923. Mask.r := dwRBitMask;
  6924. Mask.g := dwRBitMask;
  6925. Mask.b := dwRBitMask;
  6926. end;
  6927. if (dwFlags and DDPF_ALPHAPIXELS > 0) then
  6928. Mask.a := dwABitMask
  6929. else
  6930. Mask.a := 0;;
  6931. //find matching format
  6932. fd := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
  6933. result := fd.Format;
  6934. if (result <> tfEmpty) then
  6935. exit;
  6936. //find format with same Range
  6937. for i := 0 to 3 do
  6938. Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
  6939. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6940. fd := TFormatDescriptor.Get(result);
  6941. match := true;
  6942. for i := 0 to 3 do
  6943. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6944. match := false;
  6945. break;
  6946. end;
  6947. if match then
  6948. break;
  6949. end;
  6950. //no format with same range found -> use default
  6951. if (result = tfEmpty) then begin
  6952. if (dwABitMask > 0) then
  6953. result := tfRGBA8ui1
  6954. else
  6955. result := tfRGB8ub3;
  6956. end;
  6957. Converter := TbmpBitfieldFormat.Create;
  6958. Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
  6959. end;
  6960. end;
  6961. end;
  6962. var
  6963. StreamPos: Int64;
  6964. x, y, LineSize, RowSize, Magic: Cardinal;
  6965. NewImage, TmpData, RowData, SrcData: System.PByte;
  6966. SourceMD, DestMD: Pointer;
  6967. Pixel: TglBitmapPixelData;
  6968. ddsFormat: TglBitmapFormat;
  6969. FormatDesc: TFormatDescriptor;
  6970. begin
  6971. result := false;
  6972. Converter := nil;
  6973. StreamPos := aStream.Position;
  6974. // Magic
  6975. aStream.Read(Magic{%H-}, sizeof(Magic));
  6976. if (Magic <> DDS_MAGIC) then begin
  6977. aStream.Position := StreamPos;
  6978. exit;
  6979. end;
  6980. //Header
  6981. aStream.Read(Header{%H-}, sizeof(Header));
  6982. if (Header.dwSize <> SizeOf(Header)) or
  6983. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6984. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6985. begin
  6986. aStream.Position := StreamPos;
  6987. exit;
  6988. end;
  6989. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6990. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  6991. ddsFormat := GetDDSFormat;
  6992. try
  6993. if (ddsFormat = tfEmpty) then
  6994. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6995. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6996. LineSize := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
  6997. GetMem(NewImage, Header.dwHeight * LineSize);
  6998. try
  6999. TmpData := NewImage;
  7000. //Converter needed
  7001. if Assigned(Converter) then begin
  7002. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  7003. GetMem(RowData, RowSize);
  7004. SourceMD := Converter.CreateMappingData;
  7005. DestMD := FormatDesc.CreateMappingData;
  7006. try
  7007. for y := 0 to Header.dwHeight-1 do begin
  7008. TmpData := NewImage;
  7009. inc(TmpData, y * LineSize);
  7010. SrcData := RowData;
  7011. aStream.Read(SrcData^, RowSize);
  7012. for x := 0 to Header.dwWidth-1 do begin
  7013. Converter.Unmap(SrcData, Pixel, SourceMD);
  7014. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  7015. FormatDesc.Map(Pixel, TmpData, DestMD);
  7016. end;
  7017. end;
  7018. finally
  7019. Converter.FreeMappingData(SourceMD);
  7020. FormatDesc.FreeMappingData(DestMD);
  7021. FreeMem(RowData);
  7022. end;
  7023. end else
  7024. // Compressed
  7025. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  7026. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  7027. for Y := 0 to Header.dwHeight-1 do begin
  7028. aStream.Read(TmpData^, RowSize);
  7029. Inc(TmpData, LineSize);
  7030. end;
  7031. end else
  7032. // Uncompressed
  7033. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  7034. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  7035. for Y := 0 to Header.dwHeight-1 do begin
  7036. aStream.Read(TmpData^, RowSize);
  7037. Inc(TmpData, LineSize);
  7038. end;
  7039. end else
  7040. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  7041. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  7042. result := true;
  7043. except
  7044. if Assigned(NewImage) then
  7045. FreeMem(NewImage);
  7046. raise;
  7047. end;
  7048. finally
  7049. FreeAndNil(Converter);
  7050. end;
  7051. end;
  7052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7053. procedure TglBitmap.SaveDDS(const aStream: TStream);
  7054. var
  7055. Header: TDDSHeader;
  7056. FormatDesc: TFormatDescriptor;
  7057. begin
  7058. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  7059. raise EglBitmapUnsupportedFormat.Create(Format);
  7060. FormatDesc := TFormatDescriptor.Get(Format);
  7061. // Generell
  7062. FillChar(Header{%H-}, SizeOf(Header), 0);
  7063. Header.dwSize := SizeOf(Header);
  7064. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  7065. Header.dwWidth := Max(1, Width);
  7066. Header.dwHeight := Max(1, Height);
  7067. // Caps
  7068. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  7069. // Pixelformat
  7070. Header.PixelFormat.dwSize := sizeof(Header);
  7071. if (FormatDesc.IsCompressed) then begin
  7072. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  7073. case Format of
  7074. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  7075. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  7076. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  7077. end;
  7078. end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
  7079. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  7080. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7081. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7082. end else if FormatDesc.IsGrayscale then begin
  7083. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  7084. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7085. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  7086. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7087. end else begin
  7088. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  7089. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7090. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  7091. Header.PixelFormat.dwGBitMask := FormatDesc.Mask.g;
  7092. Header.PixelFormat.dwBBitMask := FormatDesc.Mask.b;
  7093. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7094. end;
  7095. if (FormatDesc.HasAlpha) then
  7096. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  7097. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  7098. aStream.Write(Header, SizeOf(Header));
  7099. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  7100. end;
  7101. {$IFNDEF OPENGL_ES}
  7102. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7103. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7105. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7106. const aWidth: Integer; const aHeight: Integer);
  7107. var
  7108. pTemp: pByte;
  7109. Size: Integer;
  7110. begin
  7111. if (aHeight > 1) then begin
  7112. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  7113. GetMem(pTemp, Size);
  7114. try
  7115. Move(aData^, pTemp^, Size);
  7116. FreeMem(aData);
  7117. aData := nil;
  7118. except
  7119. FreeMem(pTemp);
  7120. raise;
  7121. end;
  7122. end else
  7123. pTemp := aData;
  7124. inherited SetDataPointer(pTemp, aFormat, aWidth);
  7125. end;
  7126. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7127. function TglBitmap1D.FlipHorz: Boolean;
  7128. var
  7129. Col: Integer;
  7130. pTempDest, pDest, pSource: PByte;
  7131. begin
  7132. result := inherited FlipHorz;
  7133. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  7134. pSource := Data;
  7135. GetMem(pDest, fRowSize);
  7136. try
  7137. pTempDest := pDest;
  7138. Inc(pTempDest, fRowSize);
  7139. for Col := 0 to Width-1 do begin
  7140. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  7141. Move(pSource^, pTempDest^, fPixelSize);
  7142. Inc(pSource, fPixelSize);
  7143. end;
  7144. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  7145. result := true;
  7146. except
  7147. if Assigned(pDest) then
  7148. FreeMem(pDest);
  7149. raise;
  7150. end;
  7151. end;
  7152. end;
  7153. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7154. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  7155. var
  7156. FormatDesc: TFormatDescriptor;
  7157. begin
  7158. // Upload data
  7159. FormatDesc := TFormatDescriptor.Get(Format);
  7160. if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
  7161. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7162. if FormatDesc.IsCompressed then begin
  7163. if not Assigned(glCompressedTexImage1D) then
  7164. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7165. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  7166. end else if aBuildWithGlu then
  7167. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7168. else
  7169. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7170. // Free Data
  7171. if (FreeDataAfterGenTexture) then
  7172. FreeData;
  7173. end;
  7174. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7175. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  7176. var
  7177. BuildWithGlu, TexRec: Boolean;
  7178. TexSize: Integer;
  7179. begin
  7180. if Assigned(Data) then begin
  7181. // Check Texture Size
  7182. if (aTestTextureSize) then begin
  7183. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7184. if (Width > TexSize) then
  7185. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7186. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7187. (Target = GL_TEXTURE_RECTANGLE);
  7188. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7189. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7190. end;
  7191. CreateId;
  7192. SetupParameters(BuildWithGlu);
  7193. UploadData(BuildWithGlu);
  7194. glAreTexturesResident(1, @fID, @fIsResident);
  7195. end;
  7196. end;
  7197. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7198. procedure TglBitmap1D.AfterConstruction;
  7199. begin
  7200. inherited;
  7201. Target := GL_TEXTURE_1D;
  7202. end;
  7203. {$ENDIF}
  7204. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7205. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7206. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7207. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  7208. begin
  7209. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  7210. result := fLines[aIndex]
  7211. else
  7212. result := nil;
  7213. end;
  7214. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7215. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7216. const aWidth: Integer; const aHeight: Integer);
  7217. var
  7218. Idx, LineWidth: Integer;
  7219. begin
  7220. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  7221. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  7222. // Assigning Data
  7223. if Assigned(Data) then begin
  7224. SetLength(fLines, GetHeight);
  7225. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel);
  7226. for Idx := 0 to GetHeight-1 do begin
  7227. fLines[Idx] := Data;
  7228. Inc(fLines[Idx], Idx * LineWidth);
  7229. end;
  7230. end
  7231. else SetLength(fLines, 0);
  7232. end else begin
  7233. SetLength(fLines, 0);
  7234. end;
  7235. end;
  7236. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7237. procedure TglBitmap2D.UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
  7238. var
  7239. FormatDesc: TFormatDescriptor;
  7240. begin
  7241. FormatDesc := TFormatDescriptor.Get(Format);
  7242. if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
  7243. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7244. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7245. if FormatDesc.IsCompressed then begin
  7246. if not Assigned(glCompressedTexImage2D) then
  7247. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7248. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  7249. {$IFNDEF OPENGL_ES}
  7250. end else if aBuildWithGlu then begin
  7251. gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height,
  7252. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7253. {$ENDIF}
  7254. end else begin
  7255. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  7256. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7257. end;
  7258. // Freigeben
  7259. if (FreeDataAfterGenTexture) then
  7260. FreeData;
  7261. end;
  7262. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7263. procedure TglBitmap2D.AfterConstruction;
  7264. begin
  7265. inherited;
  7266. Target := GL_TEXTURE_2D;
  7267. end;
  7268. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7269. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  7270. var
  7271. Temp: pByte;
  7272. Size, w, h: Integer;
  7273. FormatDesc: TFormatDescriptor;
  7274. begin
  7275. FormatDesc := TFormatDescriptor.Get(aFormat);
  7276. if FormatDesc.IsCompressed then
  7277. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7278. w := aRight - aLeft;
  7279. h := aBottom - aTop;
  7280. Size := FormatDesc.GetSize(w, h);
  7281. GetMem(Temp, Size);
  7282. try
  7283. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7284. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7285. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  7286. FlipVert;
  7287. except
  7288. if Assigned(Temp) then
  7289. FreeMem(Temp);
  7290. raise;
  7291. end;
  7292. end;
  7293. {$IFNDEF OPENGL_ES}
  7294. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7295. procedure TglBitmap2D.GetDataFromTexture;
  7296. var
  7297. Temp: PByte;
  7298. TempWidth, TempHeight: Integer;
  7299. TempIntFormat: GLint;
  7300. IntFormat: TglBitmapFormat;
  7301. FormatDesc: TFormatDescriptor;
  7302. begin
  7303. Bind;
  7304. // Request Data
  7305. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7306. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7307. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7308. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7309. IntFormat := FormatDesc.Format;
  7310. // Getting data from OpenGL
  7311. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7312. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7313. try
  7314. if FormatDesc.IsCompressed then begin
  7315. if not Assigned(glGetCompressedTexImage) then
  7316. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7317. glGetCompressedTexImage(Target, 0, Temp)
  7318. end else
  7319. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7320. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7321. except
  7322. if Assigned(Temp) then
  7323. FreeMem(Temp);
  7324. raise;
  7325. end;
  7326. end;
  7327. {$ENDIF}
  7328. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7329. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7330. var
  7331. {$IFNDEF OPENGL_ES}
  7332. BuildWithGlu, TexRec: Boolean;
  7333. {$ENDIF}
  7334. PotTex: Boolean;
  7335. TexSize: Integer;
  7336. begin
  7337. if Assigned(Data) then begin
  7338. // Check Texture Size
  7339. if (aTestTextureSize) then begin
  7340. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7341. if ((Height > TexSize) or (Width > TexSize)) then
  7342. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7343. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7344. {$IF NOT DEFINED(OPENGL_ES)}
  7345. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7346. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7347. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7348. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7349. if not PotTex and not GL_OES_texture_npot then
  7350. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7351. {$ELSE}
  7352. if not PotTex then
  7353. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7354. {$IFEND}
  7355. end;
  7356. CreateId;
  7357. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7358. UploadData(Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7359. {$IFNDEF OPENGL_ES}
  7360. glAreTexturesResident(1, @fID, @fIsResident);
  7361. {$ENDIF}
  7362. end;
  7363. end;
  7364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7365. function TglBitmap2D.FlipHorz: Boolean;
  7366. var
  7367. Col, Row: Integer;
  7368. TempDestData, DestData, SourceData: PByte;
  7369. ImgSize: Integer;
  7370. begin
  7371. result := inherited FlipHorz;
  7372. if Assigned(Data) then begin
  7373. SourceData := Data;
  7374. ImgSize := Height * fRowSize;
  7375. GetMem(DestData, ImgSize);
  7376. try
  7377. TempDestData := DestData;
  7378. Dec(TempDestData, fRowSize + fPixelSize);
  7379. for Row := 0 to Height -1 do begin
  7380. Inc(TempDestData, fRowSize * 2);
  7381. for Col := 0 to Width -1 do begin
  7382. Move(SourceData^, TempDestData^, fPixelSize);
  7383. Inc(SourceData, fPixelSize);
  7384. Dec(TempDestData, fPixelSize);
  7385. end;
  7386. end;
  7387. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7388. result := true;
  7389. except
  7390. if Assigned(DestData) then
  7391. FreeMem(DestData);
  7392. raise;
  7393. end;
  7394. end;
  7395. end;
  7396. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7397. function TglBitmap2D.FlipVert: Boolean;
  7398. var
  7399. Row: Integer;
  7400. TempDestData, DestData, SourceData: PByte;
  7401. begin
  7402. result := inherited FlipVert;
  7403. if Assigned(Data) then begin
  7404. SourceData := Data;
  7405. GetMem(DestData, Height * fRowSize);
  7406. try
  7407. TempDestData := DestData;
  7408. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7409. for Row := 0 to Height -1 do begin
  7410. Move(SourceData^, TempDestData^, fRowSize);
  7411. Dec(TempDestData, fRowSize);
  7412. Inc(SourceData, fRowSize);
  7413. end;
  7414. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7415. result := true;
  7416. except
  7417. if Assigned(DestData) then
  7418. FreeMem(DestData);
  7419. raise;
  7420. end;
  7421. end;
  7422. end;
  7423. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7424. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7426. type
  7427. TMatrixItem = record
  7428. X, Y: Integer;
  7429. W: Single;
  7430. end;
  7431. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7432. TglBitmapToNormalMapRec = Record
  7433. Scale: Single;
  7434. Heights: array of Single;
  7435. MatrixU : array of TMatrixItem;
  7436. MatrixV : array of TMatrixItem;
  7437. end;
  7438. const
  7439. ONE_OVER_255 = 1 / 255;
  7440. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7441. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7442. var
  7443. Val: Single;
  7444. begin
  7445. with FuncRec do begin
  7446. Val :=
  7447. Source.Data.r * LUMINANCE_WEIGHT_R +
  7448. Source.Data.g * LUMINANCE_WEIGHT_G +
  7449. Source.Data.b * LUMINANCE_WEIGHT_B;
  7450. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7451. end;
  7452. end;
  7453. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7454. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7455. begin
  7456. with FuncRec do
  7457. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7458. end;
  7459. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7460. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7461. type
  7462. TVec = Array[0..2] of Single;
  7463. var
  7464. Idx: Integer;
  7465. du, dv: Double;
  7466. Len: Single;
  7467. Vec: TVec;
  7468. function GetHeight(X, Y: Integer): Single;
  7469. begin
  7470. with FuncRec do begin
  7471. X := Max(0, Min(Size.X -1, X));
  7472. Y := Max(0, Min(Size.Y -1, Y));
  7473. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7474. end;
  7475. end;
  7476. begin
  7477. with FuncRec do begin
  7478. with PglBitmapToNormalMapRec(Args)^ do begin
  7479. du := 0;
  7480. for Idx := Low(MatrixU) to High(MatrixU) do
  7481. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7482. dv := 0;
  7483. for Idx := Low(MatrixU) to High(MatrixU) do
  7484. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7485. Vec[0] := -du * Scale;
  7486. Vec[1] := -dv * Scale;
  7487. Vec[2] := 1;
  7488. end;
  7489. // Normalize
  7490. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7491. if Len <> 0 then begin
  7492. Vec[0] := Vec[0] * Len;
  7493. Vec[1] := Vec[1] * Len;
  7494. Vec[2] := Vec[2] * Len;
  7495. end;
  7496. // Farbe zuweisem
  7497. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7498. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7499. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7500. end;
  7501. end;
  7502. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7503. procedure TglBitmap2D.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7504. var
  7505. Rec: TglBitmapToNormalMapRec;
  7506. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7507. begin
  7508. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7509. Matrix[Index].X := X;
  7510. Matrix[Index].Y := Y;
  7511. Matrix[Index].W := W;
  7512. end;
  7513. end;
  7514. begin
  7515. if TFormatDescriptor.Get(Format).IsCompressed then
  7516. raise EglBitmapUnsupportedFormat.Create(Format);
  7517. if aScale > 100 then
  7518. Rec.Scale := 100
  7519. else if aScale < -100 then
  7520. Rec.Scale := -100
  7521. else
  7522. Rec.Scale := aScale;
  7523. SetLength(Rec.Heights, Width * Height);
  7524. try
  7525. case aFunc of
  7526. nm4Samples: begin
  7527. SetLength(Rec.MatrixU, 2);
  7528. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7529. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7530. SetLength(Rec.MatrixV, 2);
  7531. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7532. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7533. end;
  7534. nmSobel: begin
  7535. SetLength(Rec.MatrixU, 6);
  7536. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7537. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7538. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7539. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7540. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7541. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7542. SetLength(Rec.MatrixV, 6);
  7543. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7544. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7545. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7546. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7547. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7548. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7549. end;
  7550. nm3x3: begin
  7551. SetLength(Rec.MatrixU, 6);
  7552. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7553. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7554. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7555. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7556. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7557. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7558. SetLength(Rec.MatrixV, 6);
  7559. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7560. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7561. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7562. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7563. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7564. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7565. end;
  7566. nm5x5: begin
  7567. SetLength(Rec.MatrixU, 20);
  7568. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7569. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7570. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7571. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7572. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7573. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7574. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7575. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7576. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7577. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7578. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7579. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7580. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7581. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7582. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7583. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7584. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7585. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7586. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7587. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7588. SetLength(Rec.MatrixV, 20);
  7589. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7590. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7591. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7592. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7593. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7594. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7595. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7596. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7597. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7598. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7599. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7600. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7601. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7602. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7603. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7604. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7605. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7606. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7607. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7608. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7609. end;
  7610. end;
  7611. // Daten Sammeln
  7612. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7613. Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7614. else
  7615. Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7616. Convert(glBitmapToNormalMapFunc, false, @Rec);
  7617. finally
  7618. SetLength(Rec.Heights, 0);
  7619. end;
  7620. end;
  7621. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7622. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7623. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7624. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7625. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7626. begin
  7627. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7628. end;
  7629. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7630. procedure TglBitmapCubeMap.AfterConstruction;
  7631. begin
  7632. inherited;
  7633. {$IFNDEF OPENGL_ES}
  7634. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7635. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7636. {$ELSE}
  7637. if not (GL_VERSION_2_0) then
  7638. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7639. {$ENDIF}
  7640. SetWrap;
  7641. Target := GL_TEXTURE_CUBE_MAP;
  7642. {$IFNDEF OPENGL_ES}
  7643. fGenMode := GL_REFLECTION_MAP;
  7644. {$ENDIF}
  7645. end;
  7646. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7647. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7648. var
  7649. {$IFNDEF OPENGL_ES}
  7650. BuildWithGlu: Boolean;
  7651. {$ENDIF}
  7652. TexSize: Integer;
  7653. begin
  7654. if (aTestTextureSize) then begin
  7655. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7656. if (Height > TexSize) or (Width > TexSize) then
  7657. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7658. {$IF NOT DEFINED(OPENGL_ES)}
  7659. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7660. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7661. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7662. if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) and not GL_OES_texture_npot then
  7663. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7664. {$ELSE}
  7665. if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) then
  7666. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7667. {$IFEND}
  7668. end;
  7669. if (ID = 0) then
  7670. CreateID;
  7671. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7672. UploadData(aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7673. end;
  7674. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7675. procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
  7676. begin
  7677. inherited Bind (aEnableTextureUnit);
  7678. {$IFNDEF OPENGL_ES}
  7679. if aEnableTexCoordsGen then begin
  7680. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7681. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7682. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7683. glEnable(GL_TEXTURE_GEN_S);
  7684. glEnable(GL_TEXTURE_GEN_T);
  7685. glEnable(GL_TEXTURE_GEN_R);
  7686. end;
  7687. {$ENDIF}
  7688. end;
  7689. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7690. procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
  7691. begin
  7692. inherited Unbind(aDisableTextureUnit);
  7693. {$IFNDEF OPENGL_ES}
  7694. if aDisableTexCoordsGen then begin
  7695. glDisable(GL_TEXTURE_GEN_S);
  7696. glDisable(GL_TEXTURE_GEN_T);
  7697. glDisable(GL_TEXTURE_GEN_R);
  7698. end;
  7699. {$ENDIF}
  7700. end;
  7701. {$IFEND}
  7702. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7703. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7704. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7705. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7706. type
  7707. TVec = Array[0..2] of Single;
  7708. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7709. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7710. TglBitmapNormalMapRec = record
  7711. HalfSize : Integer;
  7712. Func: TglBitmapNormalMapGetVectorFunc;
  7713. end;
  7714. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7715. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7716. begin
  7717. aVec[0] := aHalfSize;
  7718. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7719. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7720. end;
  7721. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7722. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7723. begin
  7724. aVec[0] := - aHalfSize;
  7725. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7726. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7727. end;
  7728. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7729. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7730. begin
  7731. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7732. aVec[1] := aHalfSize;
  7733. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7734. end;
  7735. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7736. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7737. begin
  7738. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7739. aVec[1] := - aHalfSize;
  7740. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7741. end;
  7742. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7743. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7744. begin
  7745. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7746. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7747. aVec[2] := aHalfSize;
  7748. end;
  7749. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7750. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7751. begin
  7752. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7753. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7754. aVec[2] := - aHalfSize;
  7755. end;
  7756. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7757. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7758. var
  7759. i: Integer;
  7760. Vec: TVec;
  7761. Len: Single;
  7762. begin
  7763. with FuncRec do begin
  7764. with PglBitmapNormalMapRec(Args)^ do begin
  7765. Func(Vec, Position, HalfSize);
  7766. // Normalize
  7767. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7768. if Len <> 0 then begin
  7769. Vec[0] := Vec[0] * Len;
  7770. Vec[1] := Vec[1] * Len;
  7771. Vec[2] := Vec[2] * Len;
  7772. end;
  7773. // Scale Vector and AddVectro
  7774. Vec[0] := Vec[0] * 0.5 + 0.5;
  7775. Vec[1] := Vec[1] * 0.5 + 0.5;
  7776. Vec[2] := Vec[2] * 0.5 + 0.5;
  7777. end;
  7778. // Set Color
  7779. for i := 0 to 2 do
  7780. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7781. end;
  7782. end;
  7783. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7784. procedure TglBitmapNormalMap.AfterConstruction;
  7785. begin
  7786. inherited;
  7787. {$IFNDEF OPENGL_ES}
  7788. fGenMode := GL_NORMAL_MAP;
  7789. {$ENDIF}
  7790. end;
  7791. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7792. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7793. var
  7794. Rec: TglBitmapNormalMapRec;
  7795. SizeRec: TglBitmapSize;
  7796. begin
  7797. Rec.HalfSize := aSize div 2;
  7798. FreeDataAfterGenTexture := false;
  7799. SizeRec.Fields := [ffX, ffY];
  7800. SizeRec.X := aSize;
  7801. SizeRec.Y := aSize;
  7802. // Positive X
  7803. Rec.Func := glBitmapNormalMapPosX;
  7804. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7805. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7806. // Negative X
  7807. Rec.Func := glBitmapNormalMapNegX;
  7808. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7809. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7810. // Positive Y
  7811. Rec.Func := glBitmapNormalMapPosY;
  7812. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7813. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7814. // Negative Y
  7815. Rec.Func := glBitmapNormalMapNegY;
  7816. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7817. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7818. // Positive Z
  7819. Rec.Func := glBitmapNormalMapPosZ;
  7820. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7821. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7822. // Negative Z
  7823. Rec.Func := glBitmapNormalMapNegZ;
  7824. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7825. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7826. end;
  7827. {$IFEND}
  7828. initialization
  7829. glBitmapSetDefaultFormat (tfEmpty);
  7830. glBitmapSetDefaultMipmap (mmMipmap);
  7831. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7832. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7833. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7834. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7835. {$IFEND}
  7836. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7837. glBitmapSetDefaultDeleteTextureOnFree (true);
  7838. TFormatDescriptor.Init;
  7839. finalization
  7840. TFormatDescriptor.Finalize;
  7841. end.