You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

8967 lines
322 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. // Please uncomment the defines below to configure the glBitmap to your preferences.
  23. // If you have configured the unit you can uncomment the warning above.
  24. {.$MESSAGE error 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  25. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  26. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  27. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  28. // enable support for OpenGL ES 1.1
  29. {.$DEFINE OPENGL_ES_1_1}
  30. // enable support for OpenGL ES 2.0
  31. {.$DEFINE OPENGL_ES_2_0}
  32. // enable support for OpenGL ES 3.0
  33. {.$DEFINE OPENGL_ES_3_0}
  34. // enable support for all OpenGL ES extensions
  35. {.$DEFINE OPENGL_ES_EXT}
  36. // activate to enable the support for SDL_surfaces
  37. {.$DEFINE GLB_SDL}
  38. // activate to enable the support for Delphi (including support for Delphi's (not Lazarus') TBitmap)
  39. {.$DEFINE GLB_DELPHI}
  40. // activate to enable the support for TLazIntfImage from Lazarus
  41. {.$DEFINE GLB_LAZARUS}
  42. // activate to enable the support of SDL_image to load files. (READ ONLY)
  43. // If you enable SDL_image all other libraries will be ignored!
  44. {.$DEFINE GLB_SDL_IMAGE}
  45. // activate to enable Lazarus TPortableNetworkGraphic support
  46. // if you enable this pngImage and libPNG will be ignored
  47. {.$DEFINE GLB_LAZ_PNG}
  48. // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
  49. // if you enable pngimage the libPNG will be ignored
  50. {.$DEFINE GLB_PNGIMAGE}
  51. // activate to use the libPNG -> http://www.libpng.org/
  52. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
  53. {.$DEFINE GLB_LIB_PNG}
  54. // activate to enable Lazarus TJPEGImage support
  55. // if you enable this delphi jpegs and libJPEG will be ignored
  56. {.$DEFINE GLB_LAZ_JPEG}
  57. // if you enable delphi jpegs the libJPEG will be ignored
  58. {.$DEFINE GLB_DELPHI_JPEG}
  59. // activate to use the libJPEG -> http://www.ijg.org/
  60. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
  61. {.$DEFINE GLB_LIB_JPEG}
  62. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  63. // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  64. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  65. // Delphi Versions
  66. {$IFDEF fpc}
  67. {$MODE Delphi}
  68. {$IFDEF CPUI386}
  69. {$DEFINE CPU386}
  70. {$ASMMODE INTEL}
  71. {$ENDIF}
  72. {$IFNDEF WINDOWS}
  73. {$linklib c}
  74. {$ENDIF}
  75. {$ENDIF}
  76. // Operation System
  77. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  78. {$DEFINE GLB_WIN}
  79. {$ELSEIF DEFINED(LINUX)}
  80. {$DEFINE GLB_LINUX}
  81. {$IFEND}
  82. // OpenGL ES
  83. {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  84. {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}
  85. {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  86. {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES} {$IFEND}
  87. // checking define combinations
  88. //SDL Image
  89. {$IFDEF GLB_SDL_IMAGE}
  90. {$IFNDEF GLB_SDL}
  91. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  92. {$DEFINE GLB_SDL}
  93. {$ENDIF}
  94. {$IFDEF GLB_LAZ_PNG}
  95. {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  96. {$undef GLB_LAZ_PNG}
  97. {$ENDIF}
  98. {$IFDEF GLB_PNGIMAGE}
  99. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  100. {$undef GLB_PNGIMAGE}
  101. {$ENDIF}
  102. {$IFDEF GLB_LAZ_JPEG}
  103. {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  104. {$undef GLB_LAZ_JPEG}
  105. {$ENDIF}
  106. {$IFDEF GLB_DELPHI_JPEG}
  107. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  108. {$undef GLB_DELPHI_JPEG}
  109. {$ENDIF}
  110. {$IFDEF GLB_LIB_PNG}
  111. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  112. {$undef GLB_LIB_PNG}
  113. {$ENDIF}
  114. {$IFDEF GLB_LIB_JPEG}
  115. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  116. {$undef GLB_LIB_JPEG}
  117. {$ENDIF}
  118. {$DEFINE GLB_SUPPORT_PNG_READ}
  119. {$DEFINE GLB_SUPPORT_JPEG_READ}
  120. {$ENDIF}
  121. // Lazarus TPortableNetworkGraphic
  122. {$IFDEF GLB_LAZ_PNG}
  123. {$IFNDEF GLB_LAZARUS}
  124. {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
  125. {$DEFINE GLB_LAZARUS}
  126. {$ENDIF}
  127. {$IFDEF GLB_PNGIMAGE}
  128. {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  129. {$undef GLB_PNGIMAGE}
  130. {$ENDIF}
  131. {$IFDEF GLB_LIB_PNG}
  132. {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  133. {$undef GLB_LIB_PNG}
  134. {$ENDIF}
  135. {$DEFINE GLB_SUPPORT_PNG_READ}
  136. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  137. {$ENDIF}
  138. // PNG Image
  139. {$IFDEF GLB_PNGIMAGE}
  140. {$IFDEF GLB_LIB_PNG}
  141. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  142. {$undef GLB_LIB_PNG}
  143. {$ENDIF}
  144. {$DEFINE GLB_SUPPORT_PNG_READ}
  145. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  146. {$ENDIF}
  147. // libPNG
  148. {$IFDEF GLB_LIB_PNG}
  149. {$DEFINE GLB_SUPPORT_PNG_READ}
  150. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  151. {$ENDIF}
  152. // Lazarus TJPEGImage
  153. {$IFDEF GLB_LAZ_JPEG}
  154. {$IFNDEF GLB_LAZARUS}
  155. {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
  156. {$DEFINE GLB_LAZARUS}
  157. {$ENDIF}
  158. {$IFDEF GLB_DELPHI_JPEG}
  159. {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
  160. {$undef GLB_DELPHI_JPEG}
  161. {$ENDIF}
  162. {$IFDEF GLB_LIB_JPEG}
  163. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
  164. {$undef GLB_LIB_JPEG}
  165. {$ENDIF}
  166. {$DEFINE GLB_SUPPORT_JPEG_READ}
  167. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  168. {$ENDIF}
  169. // JPEG Image
  170. {$IFDEF GLB_DELPHI_JPEG}
  171. {$IFDEF GLB_LIB_JPEG}
  172. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  173. {$undef GLB_LIB_JPEG}
  174. {$ENDIF}
  175. {$DEFINE GLB_SUPPORT_JPEG_READ}
  176. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  177. {$ENDIF}
  178. // libJPEG
  179. {$IFDEF GLB_LIB_JPEG}
  180. {$DEFINE GLB_SUPPORT_JPEG_READ}
  181. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  182. {$ENDIF}
  183. // general options
  184. {$EXTENDEDSYNTAX ON}
  185. {$LONGSTRINGS ON}
  186. {$ALIGN ON}
  187. {$IFNDEF FPC}
  188. {$OPTIMIZATION ON}
  189. {$ENDIF}
  190. interface
  191. uses
  192. {$IFDEF OPENGL_ES} dglOpenGLES,
  193. {$ELSE} dglOpenGL, {$ENDIF}
  194. {$IF DEFINED(GLB_WIN) AND
  195. DEFINED(GLB_DELPHI)} windows, {$IFEND}
  196. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  197. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  198. {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$ENDIF}
  199. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  200. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  201. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  202. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  203. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  204. Classes, SysUtils;
  205. type
  206. {$IFNDEF fpc}
  207. QWord = System.UInt64;
  208. PQWord = ^QWord;
  209. PtrInt = Longint;
  210. PtrUInt = DWord;
  211. {$ENDIF}
  212. { type that describes the format of the data stored in a texture.
  213. the name of formats is composed of the following constituents:
  214. - multiple channels:
  215. - channel (e.g. R, G, B, A or Alpha, Luminance or X (reserved))
  216. - width of the chanel in bit (4, 8, 16, ...)
  217. - data type (e.g. ub, us, ui)
  218. - number of elements of data types }
  219. TglBitmapFormat = (
  220. tfEmpty = 0,
  221. tfAlpha4ub1, //< 1 x unsigned byte
  222. tfAlpha8ub1, //< 1 x unsigned byte
  223. tfAlpha16us1, //< 1 x unsigned short
  224. tfLuminance4ub1, //< 1 x unsigned byte
  225. tfLuminance8ub1, //< 1 x unsigned byte
  226. tfLuminance16us1, //< 1 x unsigned short
  227. tfLuminance4Alpha4ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  228. tfLuminance6Alpha2ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  229. tfLuminance8Alpha8ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  230. tfLuminance12Alpha4us2, //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
  231. tfLuminance16Alpha16us2, //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
  232. tfR3G3B2ub1, //< 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
  233. tfRGBX4us1, //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
  234. tfXRGB4us1, //< 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
  235. tfR5G6B5us1, //< 1 x unsigned short (5bit red, 6bit green, 5bit blue)
  236. tfRGB5X1us1, //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
  237. tfX1RGB5us1, //< 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
  238. tfRGB8ub3, //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
  239. tfRGBX8ui1, //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
  240. tfXRGB8ui1, //< 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
  241. tfRGB10X2ui1, //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
  242. tfX2RGB10ui1, //< 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
  243. tfRGB16us3, //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
  244. tfRGBA4us1, //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
  245. tfARGB4us1, //< 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
  246. tfRGB5A1us1, //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
  247. tfA1RGB5us1, //< 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
  248. tfRGBA8ui1, //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
  249. tfARGB8ui1, //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
  250. tfRGBA8ub4, //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
  251. tfRGB10A2ui1, //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
  252. tfA2RGB10ui1, //< 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
  253. tfRGBA16us4, //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
  254. tfBGRX4us1, //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
  255. tfXBGR4us1, //< 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
  256. tfB5G6R5us1, //< 1 x unsigned short (5bit blue, 6bit green, 5bit red)
  257. tfBGR5X1us1, //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
  258. tfX1BGR5us1, //< 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
  259. tfBGR8ub3, //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
  260. tfBGRX8ui1, //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
  261. tfXBGR8ui1, //< 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
  262. tfBGR10X2ui1, //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
  263. tfX2BGR10ui1, //< 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
  264. tfBGR16us3, //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
  265. tfBGRA4us1, //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
  266. tfABGR4us1, //< 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
  267. tfBGR5A1us1, //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
  268. tfA1BGR5us1, //< 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
  269. tfBGRA8ui1, //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
  270. tfABGR8ui1, //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
  271. tfBGRA8ub4, //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
  272. tfBGR10A2ui1, //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
  273. tfA2BGR10ui1, //< 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
  274. tfBGRA16us4, //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
  275. tfDepth16us1, //< 1 x unsigned short (depth)
  276. tfDepth24ui1, //< 1 x unsigned int (depth)
  277. tfDepth32ui1, //< 1 x unsigned int (depth)
  278. tfS3tcDtx1RGBA,
  279. tfS3tcDtx3RGBA,
  280. tfS3tcDtx5RGBA
  281. );
  282. { type to define suitable file formats }
  283. TglBitmapFileType = (
  284. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF} //< Portable Network Graphic file (PNG)
  285. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF} //< JPEG file
  286. ftDDS, //< Direct Draw Surface file (DDS)
  287. ftTGA, //< Targa Image File (TGA)
  288. ftBMP, //< Windows Bitmap File (BMP)
  289. ftRAW); //< glBitmap RAW file format
  290. TglBitmapFileTypes = set of TglBitmapFileType;
  291. { possible mipmap types }
  292. TglBitmapMipMap = (
  293. mmNone, //< no mipmaps
  294. mmMipmap, //< normal mipmaps
  295. mmMipmapGlu); //< mipmaps generated with glu functions
  296. { possible normal map functions }
  297. TglBitmapNormalMapFunc = (
  298. nm4Samples,
  299. nmSobel,
  300. nm3x3,
  301. nm5x5);
  302. ////////////////////////////////////////////////////////////////////////////////////////////////////
  303. EglBitmap = class(Exception); //< glBitmap exception
  304. EglBitmapNotSupported = class(Exception); //< exception for not supported functions
  305. EglBitmapSizeToLarge = class(EglBitmap); //< exception for to large textures
  306. EglBitmapNonPowerOfTwo = class(EglBitmap); //< exception for non power of two textures
  307. EglBitmapUnsupportedFormat = class(EglBitmap) //< exception for unsupporetd formats
  308. public
  309. constructor Create(const aFormat: TglBitmapFormat); overload;
  310. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  311. end;
  312. ////////////////////////////////////////////////////////////////////////////////////////////////////
  313. { record that stores 4 unsigned integer values }
  314. TglBitmapRec4ui = packed record
  315. case Integer of
  316. 0: (r, g, b, a: Cardinal);
  317. 1: (arr: array[0..3] of Cardinal);
  318. end;
  319. { record that stores 4 unsigned byte values }
  320. TglBitmapRec4ub = packed record
  321. case Integer of
  322. 0: (r, g, b, a: Byte);
  323. 1: (arr: array[0..3] of Byte);
  324. end;
  325. { record that stores 4 unsigned long integer values }
  326. TglBitmapRec4ul = packed record
  327. case Integer of
  328. 0: (r, g, b, a: QWord);
  329. 1: (arr: array[0..3] of QWord);
  330. end;
  331. { describes the properties of a given texture data format }
  332. TglBitmapFormatDescriptor = class(TObject)
  333. private
  334. // cached properties
  335. fBytesPerPixel: Single; //< number of bytes for each pixel
  336. fChannelCount: Integer; //< number of color channels
  337. fMask: TglBitmapRec4ul; //< bitmask for each color channel
  338. fRange: TglBitmapRec4ui; //< maximal value of each color channel
  339. { @return @true if the format has a red color channel, @false otherwise }
  340. function GetHasRed: Boolean;
  341. { @return @true if the format has a green color channel, @false otherwise }
  342. function GetHasGreen: Boolean;
  343. { @return @true if the format has a blue color channel, @false otherwise }
  344. function GetHasBlue: Boolean;
  345. { @return @true if the format has a alpha color channel, @false otherwise }
  346. function GetHasAlpha: Boolean;
  347. { @return @true if the format has any color color channel, @false otherwise }
  348. function GetHasColor: Boolean;
  349. { @return @true if the format is a grayscale format, @false otherwise }
  350. function GetIsGrayscale: Boolean;
  351. protected
  352. fFormat: TglBitmapFormat; //< format this descriptor belongs to
  353. fWithAlpha: TglBitmapFormat; //< suitable format with alpha channel
  354. fWithoutAlpha: TglBitmapFormat; //< suitable format without alpha channel
  355. fOpenGLFormat: TglBitmapFormat; //< suitable format that is supported by OpenGL
  356. fRGBInverted: TglBitmapFormat; //< suitable format with inverted RGB channels
  357. fUncompressed: TglBitmapFormat; //< suitable format with uncompressed data
  358. fBitsPerPixel: Integer; //< number of bits per pixel
  359. fIsCompressed: Boolean; //< @true if the format is compressed, @false otherwise
  360. fPrecision: TglBitmapRec4ub; //< number of bits for each color channel
  361. fShift: TglBitmapRec4ub; //< bit offset for each color channel
  362. fglFormat: GLenum; //< OpenGL format enum (e.g. GL_RGB)
  363. fglInternalFormat: GLenum; //< OpenGL internal format enum (e.g. GL_RGB8)
  364. fglDataFormat: GLenum; //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
  365. { set values for this format descriptor }
  366. procedure SetValues; virtual;
  367. { calculate cached values }
  368. procedure CalcValues;
  369. public
  370. property Format: TglBitmapFormat read fFormat; //< format this descriptor belongs to
  371. property ChannelCount: Integer read fChannelCount; //< number of color channels
  372. property IsCompressed: Boolean read fIsCompressed; //< @true if the format is compressed, @false otherwise
  373. property BitsPerPixel: Integer read fBitsPerPixel; //< number of bytes per pixel
  374. property BytesPerPixel: Single read fBytesPerPixel; //< number of bits per pixel
  375. property Precision: TglBitmapRec4ub read fPrecision; //< number of bits for each color channel
  376. property Shift: TglBitmapRec4ub read fShift; //< bit offset for each color channel
  377. property Range: TglBitmapRec4ui read fRange; //< maximal value of each color channel
  378. property Mask: TglBitmapRec4ul read fMask; //< bitmask for each color channel
  379. property RGBInverted: TglBitmapFormat read fRGBInverted; //< suitable format with inverted RGB channels
  380. property WithAlpha: TglBitmapFormat read fWithAlpha; //< suitable format with alpha channel
  381. property WithoutAlpha: TglBitmapFormat read fWithAlpha; //< suitable format without alpha channel
  382. property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL
  383. property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data
  384. property glFormat: GLenum read fglFormat; //< OpenGL format enum (e.g. GL_RGB)
  385. property glInternalFormat: GLenum read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8)
  386. property glDataFormat: GLenum read fglDataFormat; //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
  387. property HasRed: Boolean read GetHasRed; //< @true if the format has a red color channel, @false otherwise
  388. property HasGreen: Boolean read GetHasGreen; //< @true if the format has a green color channel, @false otherwise
  389. property HasBlue: Boolean read GetHasBlue; //< @true if the format has a blue color channel, @false otherwise
  390. property HasAlpha: Boolean read GetHasAlpha; //< @true if the format has a alpha color channel, @false otherwise
  391. property HasColor: Boolean read GetHasColor; //< @true if the format has any color color channel, @false otherwise
  392. property IsGrayscale: Boolean read GetIsGrayscale; //< @true if the format is a grayscale format, @false otherwise
  393. { constructor }
  394. constructor Create;
  395. public
  396. { get the format descriptor by a given OpenGL internal format
  397. @param aInternalFormat OpenGL internal format to get format descriptor for
  398. @returns suitable format descriptor or tfEmpty-Descriptor }
  399. class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  400. end;
  401. ////////////////////////////////////////////////////////////////////////////////////////////////////
  402. { structure to store pixel data in }
  403. TglBitmapPixelData = packed record
  404. Data: TglBitmapRec4ui; //< color data for each color channel
  405. Range: TglBitmapRec4ui; //< maximal color value for each channel
  406. Format: TglBitmapFormat; //< format of the pixel
  407. end;
  408. PglBitmapPixelData = ^TglBitmapPixelData;
  409. TglBitmapSizeFields = set of (ffX, ffY);
  410. TglBitmapSize = packed record
  411. Fields: TglBitmapSizeFields;
  412. X: Word;
  413. Y: Word;
  414. end;
  415. TglBitmapPixelPosition = TglBitmapSize;
  416. ////////////////////////////////////////////////////////////////////////////////////////////////////
  417. TglBitmap = class;
  418. { structure to store data for converting in }
  419. TglBitmapFunctionRec = record
  420. Sender: TglBitmap; //< texture object that stores the data to convert
  421. Size: TglBitmapSize; //< size of the texture
  422. Position: TglBitmapPixelPosition; //< position of the currently pixel
  423. Source: TglBitmapPixelData; //< pixel data of the current pixel
  424. Dest: TglBitmapPixelData; //< new data of the pixel (must be filled in)
  425. Args: Pointer; //< user defined args that was passed to the convert function
  426. end;
  427. { callback to use for converting texture data }
  428. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  429. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  430. { base class for all glBitmap classes. used to manage OpenGL texture objects
  431. and to load, save and manipulate texture data }
  432. TglBitmap = class
  433. private
  434. { @returns format descriptor that describes the format of the stored data }
  435. function GetFormatDesc: TglBitmapFormatDescriptor;
  436. protected
  437. fID: GLuint; //< name of the OpenGL texture object
  438. fTarget: GLuint; //< texture target (e.g. GL_TEXTURE_2D)
  439. fAnisotropic: Integer; //< anisotropic level
  440. fDeleteTextureOnFree: Boolean; //< delete OpenGL texture object when this object is destroyed
  441. fFreeDataOnDestroy: Boolean; //< free stored data when this object is destroyed
  442. fFreeDataAfterGenTexture: Boolean; //< free stored data after data was uploaded to video card
  443. fData: PByte; //< data of this texture
  444. {$IFNDEF OPENGL_ES}
  445. fIsResident: GLboolean; //< @true if OpenGL texture object has data, @false otherwise
  446. {$ENDIF}
  447. fBorderColor: array[0..3] of Single; //< color of the texture border
  448. fDimension: TglBitmapSize; //< size of this texture
  449. fMipMap: TglBitmapMipMap; //< mipmap type
  450. fFormat: TglBitmapFormat; //< format the texture data is stored in
  451. // Mapping
  452. fPixelSize: Integer; //< size of one pixel (in byte)
  453. fRowSize: Integer; //< size of one pixel row (in byte)
  454. // Filtering
  455. fFilterMin: GLenum; //< min filter to apply to the texture
  456. fFilterMag: GLenum; //< mag filter to apply to the texture
  457. // TexturWarp
  458. fWrapS: GLenum; //< texture wrapping for x axis
  459. fWrapT: GLenum; //< texture wrapping for y axis
  460. fWrapR: GLenum; //< texture wrapping for z axis
  461. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  462. //Swizzle
  463. fSwizzle: array[0..3] of GLenum; //< color channel swizzle
  464. {$IFEND}
  465. // CustomData
  466. fFilename: String; //< filename the texture was load from
  467. fCustomName: String; //< user defined name
  468. fCustomNameW: WideString; //< user defined name
  469. fCustomData: Pointer; //< user defined data
  470. protected
  471. { @returns the actual width of the texture }
  472. function GetWidth: Integer; virtual;
  473. { @returns the actual height of the texture }
  474. function GetHeight: Integer; virtual;
  475. { @returns the width of the texture or 1 if the width is zero }
  476. function GetFileWidth: Integer; virtual;
  477. { @returns the height of the texture or 1 if the height is zero }
  478. function GetFileHeight: Integer; virtual;
  479. protected
  480. { set a new value for fCustomData }
  481. procedure SetCustomData(const aValue: Pointer);
  482. { set a new value for fCustomName }
  483. procedure SetCustomName(const aValue: String);
  484. { set a new value for fCustomNameW }
  485. procedure SetCustomNameW(const aValue: WideString);
  486. { set new value for fFreeDataOnDestroy }
  487. procedure SetFreeDataOnDestroy(const aValue: Boolean);
  488. { set new value for fDeleteTextureOnFree }
  489. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  490. { set new value for the data format. only possible if new format has the same pixel size.
  491. if you want to convert the texture data, see ConvertTo function }
  492. procedure SetFormat(const aValue: TglBitmapFormat);
  493. { set new value for fFreeDataAfterGenTexture }
  494. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  495. { set name of OpenGL texture object }
  496. procedure SetID(const aValue: Cardinal);
  497. { set new value for fMipMap }
  498. procedure SetMipMap(const aValue: TglBitmapMipMap);
  499. { set new value for target }
  500. procedure SetTarget(const aValue: Cardinal);
  501. { set new value for fAnisotrophic }
  502. procedure SetAnisotropic(const aValue: Integer);
  503. protected
  504. { create OpenGL texture object (delete exisiting object if exists) }
  505. procedure CreateID;
  506. { setup texture parameters }
  507. procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  508. { set data pointer of texture data
  509. @param aData pointer to new texture data (be carefull, aData could be freed by this function)
  510. @param aFormat format of the data stored at aData
  511. @param aWidth width of the texture data
  512. @param aHeight height of the texture data }
  513. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  514. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
  515. { generate texture (upload texture data to video card)
  516. @param aTestTextureSize test texture size before uploading and raise exception if something is wrong }
  517. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  518. { flip texture horizontal
  519. @returns @true in success, @false otherwise }
  520. function FlipHorz: Boolean; virtual;
  521. { flip texture vertical
  522. @returns @true in success, @false otherwise }
  523. function FlipVert: Boolean; virtual;
  524. protected
  525. property Width: Integer read GetWidth; //< the actual width of the texture
  526. property Height: Integer read GetHeight; //< the actual height of the texture
  527. property FileWidth: Integer read GetFileWidth; //< the width of the texture or 1 if the width is zero
  528. property FileHeight: Integer read GetFileHeight; //< the height of the texture or 1 if the height is zero
  529. public
  530. property ID: Cardinal read fID write SetID; //< name of the OpenGL texture object
  531. property Target: Cardinal read fTarget write SetTarget; //< texture target (e.g. GL_TEXTURE_2D)
  532. property Format: TglBitmapFormat read fFormat write SetFormat; //< format the texture data is stored in
  533. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap; //< mipmap type
  534. property Anisotropic: Integer read fAnisotropic write SetAnisotropic; //< anisotropic level
  535. property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc; //< format descriptor that describes the format of the stored data
  536. property Filename: String read fFilename; //< filename the texture was load from
  537. property CustomName: String read fCustomName write SetCustomName; //< user defined name (use at will)
  538. property CustomNameW: WideString read fCustomNameW write SetCustomNameW; //< user defined name (as WideString; use at will)
  539. property CustomData: Pointer read fCustomData write SetCustomData; //< user defined data (use at will)
  540. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree; //< delete texture object when this object is destroyed
  541. property FreeDataOnDestroy: Boolean read fFreeDataOnDestroy write SetFreeDataOnDestroy; //< free stored data when this object is destroyed
  542. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture; //< free stored data after it is uplaoded to video card
  543. property Dimension: TglBitmapSize read fDimension; //< size of the texture
  544. property Data: PByte read fData; //< texture data (or @nil if unset)
  545. {$IFNDEF OPENGL_ES}
  546. property IsResident: GLboolean read fIsResident; //< @true if OpenGL texture object has data, @false otherwise
  547. {$ENDIF}
  548. { this method is called after the constructor and sets the default values of this object }
  549. procedure AfterConstruction; override;
  550. { this method is called before the destructor and does some cleanup }
  551. procedure BeforeDestruction; override;
  552. { splits a resource identifier into the resource and it's type
  553. @param aResource resource identifier to split and store name in
  554. @param aResType type of the resource }
  555. procedure PrepareResType(var aResource: String; var aResType: PChar);
  556. public
  557. { load a texture from a file
  558. @param aFilename file to load texuture from }
  559. procedure LoadFromFile(const aFilename: String);
  560. { load a texture from a stream
  561. @param aStream stream to load texture from }
  562. procedure LoadFromStream(const aStream: TStream); virtual;
  563. { use a function to generate texture data
  564. @param aSize size of the texture
  565. @param aFunc callback to use for generation
  566. @param aFormat format of the texture data
  567. @param aArgs user defined paramaters (use at will) }
  568. procedure LoadFromFunc(const aSize: TglBitmapSize; const aFunc: TglBitmapFunction;
  569. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  570. { load a texture from a resource
  571. @param aInstance resource handle
  572. @param aResource resource indentifier
  573. @param aResType resource type (if known) }
  574. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  575. { load a texture from a resource id
  576. @param aInstance resource handle
  577. @param aResource resource ID
  578. @param aResType resource type }
  579. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  580. public
  581. { save texture data to a file
  582. @param aFilename filename to store texture in
  583. @param aFileType file type to store data into }
  584. procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
  585. { save texture data to a stream
  586. @param aFilename filename to store texture in
  587. @param aFileType file type to store data into }
  588. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  589. public
  590. { convert texture data using a user defined callback
  591. @param aFunc callback to use for converting
  592. @param aCreateTemp create a temporary buffer to use for converting
  593. @param aArgs user defined paramters (use at will)
  594. @returns @true if converting was successful, @false otherwise }
  595. function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  596. { convert texture data using a user defined callback
  597. @param aSource glBitmap to read data from
  598. @param aFunc callback to use for converting
  599. @param aCreateTemp create a temporary buffer to use for converting
  600. @param aFormat format of the new data
  601. @param aArgs user defined paramters (use at will)
  602. @returns @true if converting was successful, @false otherwise }
  603. function Convert(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  604. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  605. { convert texture data using a specific format
  606. @param aFormat new format of texture data
  607. @returns @true if converting was successful, @false otherwise }
  608. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  609. {$IFDEF GLB_SDL}
  610. public
  611. { assign texture data to SDL surface
  612. @param aSurface SDL surface to write data to
  613. @returns @true on success, @false otherwise }
  614. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  615. { assign texture data from SDL surface
  616. @param aSurface SDL surface to read data from
  617. @returns @true on success, @false otherwise }
  618. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  619. { assign alpha channel data to SDL surface
  620. @param aSurface SDL surface to write alpha channel data to
  621. @returns @true on success, @false otherwise }
  622. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  623. { assign alpha channel data from SDL surface
  624. @param aSurface SDL surface 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 AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  629. {$ENDIF}
  630. {$IFDEF GLB_DELPHI}
  631. public
  632. { assign texture data to TBitmap object
  633. @param aBitmap TBitmap to write data to
  634. @returns @true on success, @false otherwise }
  635. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  636. { assign texture data from TBitmap object
  637. @param aBitmap TBitmap to read data from
  638. @returns @true on success, @false otherwise }
  639. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  640. { assign alpha channel data to TBitmap object
  641. @param aBitmap TBitmap to write data to
  642. @returns @true on success, @false otherwise }
  643. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  644. { assign alpha channel data from TBitmap object
  645. @param aBitmap TBitmap to read data from
  646. @param aFunc callback to use for converting
  647. @param aArgs user defined parameters (use at will)
  648. @returns @true on success, @false otherwise }
  649. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  650. {$ENDIF}
  651. {$IFDEF GLB_LAZARUS}
  652. public
  653. { assign texture data to TLazIntfImage object
  654. @param aImage TLazIntfImage to write data to
  655. @returns @true on success, @false otherwise }
  656. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  657. { assign texture data from TLazIntfImage object
  658. @param aImage TLazIntfImage to read data from
  659. @returns @true on success, @false otherwise }
  660. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  661. { assign alpha channel data to TLazIntfImage object
  662. @param aImage TLazIntfImage to write data to
  663. @returns @true on success, @false otherwise }
  664. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  665. { assign alpha channel data from TLazIntfImage object
  666. @param aImage TLazIntfImage to read data from
  667. @param aFunc callback to use for converting
  668. @param aArgs user defined parameters (use at will)
  669. @returns @true on success, @false otherwise }
  670. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  671. {$ENDIF}
  672. public
  673. { load alpha channel data from resource
  674. @param aInstance resource handle
  675. @param aResource resource ID
  676. @param aResType resource type
  677. @param aFunc callback to use for converting
  678. @param aArgs user defined parameters (use at will)
  679. @returns @true on success, @false otherwise }
  680. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  681. { load alpha channel data from resource ID
  682. @param aInstance resource handle
  683. @param aResourceID resource ID
  684. @param aResType resource type
  685. @param aFunc callback to use for converting
  686. @param aArgs user defined parameters (use at will)
  687. @returns @true on success, @false otherwise }
  688. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  689. { add alpha channel data from function
  690. @param aFunc callback to get data from
  691. @param aArgs user defined parameters (use at will)
  692. @returns @true on success, @false otherwise }
  693. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  694. { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
  695. @param aFilename file to load alpha channel data from
  696. @param aFunc callback to use for converting
  697. @param aArgs user defined parameters (use at will)
  698. @returns @true on success, @false otherwise }
  699. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  700. { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
  701. @param aStream stream to load alpha channel data from
  702. @param aFunc callback to use for converting
  703. @param aArgs user defined parameters (use at will)
  704. @returns @true on success, @false otherwise }
  705. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  706. { add alpha channel data from existing glBitmap object
  707. @param aBitmap TglBitmap to copy alpha channel data from
  708. @param aFunc callback to use for converting
  709. @param aArgs user defined parameters (use at will)
  710. @returns @true on success, @false otherwise }
  711. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  712. { add alpha to pixel if the pixels color is greter than the given color value
  713. @param aRed red threshold (0-255)
  714. @param aGreen green threshold (0-255)
  715. @param aBlue blue threshold (0-255)
  716. @param aDeviatation accepted deviatation (0-255)
  717. @returns @true on success, @false otherwise }
  718. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  719. { add alpha to pixel if the pixels color is greter than the given color value
  720. @param aRed red threshold (0-Range.r)
  721. @param aGreen green threshold (0-Range.g)
  722. @param aBlue blue threshold (0-Range.b)
  723. @param aDeviatation accepted deviatation (0-max(Range.rgb))
  724. @returns @true on success, @false otherwise }
  725. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  726. { add alpha to pixel if the pixels color is greter than the given color value
  727. @param aRed red threshold (0.0-1.0)
  728. @param aGreen green threshold (0.0-1.0)
  729. @param aBlue blue threshold (0.0-1.0)
  730. @param aDeviatation accepted deviatation (0.0-1.0)
  731. @returns @true on success, @false otherwise }
  732. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  733. { add a constand alpha value to all pixels
  734. @param aAlpha alpha value to add (0-255)
  735. @returns @true on success, @false otherwise }
  736. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  737. { add a constand alpha value to all pixels
  738. @param aAlpha alpha value to add (0-max(Range.rgb))
  739. @returns @true on success, @false otherwise }
  740. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  741. { add a constand alpha value to all pixels
  742. @param aAlpha alpha value to add (0.0-1.0)
  743. @returns @true on success, @false otherwise }
  744. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  745. { remove alpha channel
  746. @returns @true on success, @false otherwise }
  747. function RemoveAlpha: Boolean; virtual;
  748. public
  749. { create a clone of the current object
  750. @returns clone of this object}
  751. function Clone: TglBitmap;
  752. { invert color data (xor)
  753. @param aUseRGB xor each color channel
  754. @param aUseAlpha xor alpha channel }
  755. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  756. { free texture stored data }
  757. procedure FreeData;
  758. {$IFNDEF OPENGL_ES}
  759. { set the new value for texture border color
  760. @param aRed red color for border (0.0-1.0)
  761. @param aGreen green color for border (0.0-1.0)
  762. @param aBlue blue color for border (0.0-1.0)
  763. @param aAlpha alpha color for border (0.0-1.0) }
  764. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  765. {$ENDIF}
  766. public
  767. { fill complete texture with one color
  768. @param aRed red color for border (0-255)
  769. @param aGreen green color for border (0-255)
  770. @param aBlue blue color for border (0-255)
  771. @param aAlpha alpha color for border (0-255) }
  772. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  773. { fill complete texture with one color
  774. @param aRed red color for border (0-Range.r)
  775. @param aGreen green color for border (0-Range.g)
  776. @param aBlue blue color for border (0-Range.b)
  777. @param aAlpha alpha color for border (0-Range.a) }
  778. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  779. { fill complete texture with one color
  780. @param aRed red color for border (0.0-1.0)
  781. @param aGreen green color for border (0.0-1.0)
  782. @param aBlue blue color for border (0.0-1.0)
  783. @param aAlpha alpha color for border (0.0-1.0) }
  784. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
  785. public
  786. { set new texture filer
  787. @param aMin min filter
  788. @param aMag mag filter }
  789. procedure SetFilter(const aMin, aMag: GLenum);
  790. { set new texture wrapping
  791. @param S texture wrapping for x axis
  792. @param T texture wrapping for y axis
  793. @param R texture wrapping for z axis }
  794. procedure SetWrap(
  795. const S: GLenum = GL_CLAMP_TO_EDGE;
  796. const T: GLenum = GL_CLAMP_TO_EDGE;
  797. const R: GLenum = GL_CLAMP_TO_EDGE);
  798. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  799. { set new swizzle
  800. @param r swizzle for red channel
  801. @param g swizzle for green channel
  802. @param b swizzle for blue channel
  803. @param a swizzle for alpha channel }
  804. procedure SetSwizzle(const r, g, b, a: GLenum);
  805. {$IFEND}
  806. public
  807. { bind texture
  808. @param aEnableTextureUnit enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
  809. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  810. { bind texture
  811. @param aDisableTextureUnit disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
  812. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  813. public
  814. { constructor - created an empty texture }
  815. constructor Create; overload;
  816. { constructor - creates a texture and load it from a file
  817. @param aFilename file to load texture from }
  818. constructor Create(const aFileName: String); overload;
  819. { constructor - creates a texture and load it from a stream
  820. @param aStream stream to load texture from }
  821. constructor Create(const aStream: TStream); overload;
  822. { constructor - creates a texture with the given size, format and data
  823. @param aSize size of the texture
  824. @param aFormat format of the given data
  825. @param aData texture data - be carefull: the data will now be managed by the glBitmap object,
  826. you can control this by setting DeleteTextureOnFree, FreeDataOnDestroy and FreeDataAfterGenTexture }
  827. constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  828. { constructor - creates a texture with the given size and format and uses the given callback to create the data
  829. @param aSize size of the texture
  830. @param aFormat format of the given data
  831. @param aFunc callback to use for generating the data
  832. @param aArgs user defined parameters (use at will) }
  833. constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  834. { constructor - creates a texture and loads it from a resource
  835. @param aInstance resource handle
  836. @param aResource resource indentifier
  837. @param aResType resource type (if known) }
  838. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  839. { constructor - creates a texture and loads it from a resource
  840. @param aInstance resource handle
  841. @param aResourceID resource ID
  842. @param aResType resource type (if known) }
  843. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  844. private
  845. {$IFDEF GLB_SUPPORT_PNG_READ}
  846. { try to load a PNG from a stream
  847. @param aStream stream to load PNG from
  848. @returns @true on success, @false otherwise }
  849. function LoadPNG(const aStream: TStream): Boolean; virtual;
  850. {$ENDIF}
  851. {$ifdef GLB_SUPPORT_PNG_WRITE}
  852. { save texture data as PNG to stream
  853. @param aStream stream to save data to}
  854. procedure SavePNG(const aStream: TStream); virtual;
  855. {$ENDIF}
  856. {$IFDEF GLB_SUPPORT_JPEG_READ}
  857. { try to load a JPEG from a stream
  858. @param aStream stream to load JPEG from
  859. @returns @true on success, @false otherwise }
  860. function LoadJPEG(const aStream: TStream): Boolean; virtual;
  861. {$ENDIF}
  862. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  863. { save texture data as JPEG to stream
  864. @param aStream stream to save data to}
  865. procedure SaveJPEG(const aStream: TStream); virtual;
  866. {$ENDIF}
  867. { try to load a RAW image from a stream
  868. @param aStream stream to load RAW image from
  869. @returns @true on success, @false otherwise }
  870. function LoadRAW(const aStream: TStream): Boolean;
  871. { save texture data as RAW image to stream
  872. @param aStream stream to save data to}
  873. procedure SaveRAW(const aStream: TStream);
  874. { try to load a BMP from a stream
  875. @param aStream stream to load BMP from
  876. @returns @true on success, @false otherwise }
  877. function LoadBMP(const aStream: TStream): Boolean;
  878. { save texture data as BMP to stream
  879. @param aStream stream to save data to}
  880. procedure SaveBMP(const aStream: TStream);
  881. { try to load a TGA from a stream
  882. @param aStream stream to load TGA from
  883. @returns @true on success, @false otherwise }
  884. function LoadTGA(const aStream: TStream): Boolean;
  885. { save texture data as TGA to stream
  886. @param aStream stream to save data to}
  887. procedure SaveTGA(const aStream: TStream);
  888. { try to load a DDS from a stream
  889. @param aStream stream to load DDS from
  890. @returns @true on success, @false otherwise }
  891. function LoadDDS(const aStream: TStream): Boolean;
  892. { save texture data as DDS to stream
  893. @param aStream stream to save data to}
  894. procedure SaveDDS(const aStream: TStream);
  895. end;
  896. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  897. {$IF NOT DEFINED(OPENGL_ES)}
  898. { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D }
  899. TglBitmap1D = class(TglBitmap)
  900. protected
  901. { set data pointer of texture data
  902. @param aData pointer to new texture data (be carefull, aData could be freed by this function)
  903. @param aFormat format of the data stored at aData
  904. @param aWidth width of the texture data
  905. @param aHeight height of the texture data }
  906. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  907. { upload the texture data to video card
  908. @param aBuildWithGlu use glu functions to build mipmaps }
  909. procedure UploadData(const aBuildWithGlu: Boolean);
  910. public
  911. property Width; //< actual with of the texture
  912. { this method is called after constructor and initializes the object }
  913. procedure AfterConstruction; override;
  914. { flip texture horizontally
  915. @returns @true on success, @fals otherwise }
  916. function FlipHorz: Boolean; override;
  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. end;
  921. {$IFEND}
  922. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  923. { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D) }
  924. TglBitmap2D = class(TglBitmap)
  925. protected
  926. fLines: array of PByte; //< array to store scanline entry points in
  927. { get a specific scanline
  928. @param aIndex index of the scanline to return
  929. @returns scanline at position aIndex or @nil }
  930. function GetScanline(const aIndex: Integer): Pointer;
  931. { set data pointer of texture data
  932. @param aData pointer to new texture data (be carefull, aData could be freed by this function)
  933. @param aFormat format of the data stored at aData
  934. @param aWidth width of the texture data
  935. @param aHeight height of the texture data }
  936. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  937. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  938. { upload the texture data to video card
  939. @param aTarget target o upload data to (e.g. GL_TEXTURE_2D)
  940. @param aBuildWithGlu use glu functions to build mipmaps }
  941. procedure UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
  942. public
  943. property Width; //< actual width of the texture
  944. property Height; //< actual height of the texture
  945. property Scanline[const aIndex: Integer]: Pointer read GetScanline; //< scanline to access texture data directly
  946. { this method is called after constructor and initializes the object }
  947. procedure AfterConstruction; override;
  948. { copy a part of the frame buffer top the texture
  949. @param aTop topmost pixel to copy
  950. @param aLeft leftmost pixel to copy
  951. @param aRight rightmost pixel to copy
  952. @param aBottom bottommost pixel to copy
  953. @param aFormat format to store data in }
  954. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  955. {$IFNDEF OPENGL_ES}
  956. { downlaod texture data from OpenGL texture object }
  957. procedure GetDataFromTexture;
  958. {$ENDIF}
  959. { generate texture (create texture object if not exist, set texture parameters and upload data)
  960. @param aTestTextureSize check the size of the texture and throw exception if something is wrong }
  961. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  962. { flip texture horizontally
  963. @returns @true on success, @false otherwise }
  964. function FlipHorz: Boolean; override;
  965. { flip texture vertically
  966. @returns @true on success, @false otherwise }
  967. function FlipVert: Boolean; override;
  968. { create normal map from texture data
  969. @param aFunc normal map function to generate normalmap with
  970. @param aScale scale of the normale stored in the normal map
  971. @param aUseAlpha generate normalmap from alpha channel data (if present) }
  972. procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  973. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  974. end;
  975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  976. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  977. { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP) }
  978. TglBitmapCubeMap = class(TglBitmap2D)
  979. protected
  980. {$IFNDEF OPENGL_ES}
  981. fGenMode: Integer; //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
  982. {$ENDIF}
  983. { generate texture (create texture object if not exist, set texture parameters and upload data
  984. do not call directly for cubemaps, use GenerateCubeMap instead
  985. @param aTestTextureSize check the size of the texture and throw exception if something is wrong }
  986. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  987. public
  988. { this method is called after constructor and initializes the object }
  989. procedure AfterConstruction; override;
  990. { generate texture (create texture object if not exist, set texture parameters and upload data
  991. @param aCubeTarget cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
  992. @param aTestTextureSize check the size of the texture and throw exception if something is wrong }
  993. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  994. { bind texture
  995. @param aEnableTexCoordsGen enable cube map generator
  996. @param aEnableTextureUnit enable texture unit }
  997. procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  998. { unbind texture
  999. @param aDisableTexCoordsGen disable cube map generator
  1000. @param aDisableTextureUnit disable texture unit }
  1001. procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  1002. end;
  1003. {$IFEND}
  1004. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  1005. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1006. { wrapper class for cube normal maps }
  1007. TglBitmapNormalMap = class(TglBitmapCubeMap)
  1008. public
  1009. { this method is called after constructor and initializes the object }
  1010. procedure AfterConstruction; override;
  1011. { create cube normal map from texture data and upload it to video card
  1012. @param aSize size of each cube map texture
  1013. @param aTestTextureSize check texture size when uploading and throw exception if something is wrong }
  1014. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  1015. end;
  1016. {$IFEND}
  1017. const
  1018. NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
  1019. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1020. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1021. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1022. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1023. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1024. procedure glBitmapSetDefaultWrap(
  1025. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1026. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1027. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1028. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1029. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1030. {$IFEND}
  1031. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1032. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1033. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1034. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1035. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1036. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1037. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1038. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1039. {$IFEND}
  1040. function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
  1041. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1042. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1043. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1044. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1045. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1046. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1047. function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
  1048. {$IFDEF GLB_DELPHI}
  1049. function CreateGrayPalette: HPALETTE;
  1050. {$ENDIF}
  1051. implementation
  1052. uses
  1053. Math, syncobjs, typinfo
  1054. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1055. var
  1056. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1057. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1058. glBitmapDefaultFormat: TglBitmapFormat;
  1059. glBitmapDefaultMipmap: TglBitmapMipMap;
  1060. glBitmapDefaultFilterMin: Cardinal;
  1061. glBitmapDefaultFilterMag: Cardinal;
  1062. glBitmapDefaultWrapS: Cardinal;
  1063. glBitmapDefaultWrapT: Cardinal;
  1064. glBitmapDefaultWrapR: Cardinal;
  1065. glDefaultSwizzle: array[0..3] of GLenum;
  1066. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1067. type
  1068. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1069. public
  1070. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1071. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1072. function GetSize(const aSize: TglBitmapSize): Integer; overload; virtual;
  1073. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1074. function CreateMappingData: Pointer; virtual;
  1075. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1076. function IsEmpty: Boolean; virtual;
  1077. function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
  1078. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1079. constructor Create; virtual;
  1080. public
  1081. class procedure Init;
  1082. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1083. class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1084. class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
  1085. class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  1086. class procedure Clear;
  1087. class procedure Finalize;
  1088. end;
  1089. TFormatDescriptorClass = class of TFormatDescriptor;
  1090. TfdEmpty = class(TFormatDescriptor);
  1091. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1092. TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
  1093. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1094. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1095. end;
  1096. TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
  1097. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1098. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1099. end;
  1100. TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
  1101. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1102. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1103. end;
  1104. TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
  1105. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1106. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1107. end;
  1108. TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
  1109. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1110. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1111. end;
  1112. TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1113. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1114. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1115. end;
  1116. TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
  1117. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1118. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1119. end;
  1120. TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
  1121. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1122. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1123. end;
  1124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1125. TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
  1126. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1127. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1128. end;
  1129. TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
  1130. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1131. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1132. end;
  1133. TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
  1134. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1135. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1136. end;
  1137. TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
  1138. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1139. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1140. end;
  1141. TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
  1142. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1143. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1144. end;
  1145. TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
  1146. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1147. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1148. end;
  1149. TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1150. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1151. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1152. end;
  1153. TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
  1154. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1155. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1156. end;
  1157. TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
  1158. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1159. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1160. end;
  1161. TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1162. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1163. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1164. end;
  1165. TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1166. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1167. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1168. end;
  1169. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1170. TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
  1171. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1172. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1173. end;
  1174. TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
  1175. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1176. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1177. end;
  1178. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1179. TfdAlpha4ub1 = class(TfdAlphaUB1)
  1180. procedure SetValues; override;
  1181. end;
  1182. TfdAlpha8ub1 = class(TfdAlphaUB1)
  1183. procedure SetValues; override;
  1184. end;
  1185. TfdAlpha16us1 = class(TfdAlphaUS1)
  1186. procedure SetValues; override;
  1187. end;
  1188. TfdLuminance4ub1 = class(TfdLuminanceUB1)
  1189. procedure SetValues; override;
  1190. end;
  1191. TfdLuminance8ub1 = class(TfdLuminanceUB1)
  1192. procedure SetValues; override;
  1193. end;
  1194. TfdLuminance16us1 = class(TfdLuminanceUS1)
  1195. procedure SetValues; override;
  1196. end;
  1197. TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
  1198. procedure SetValues; override;
  1199. end;
  1200. TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
  1201. procedure SetValues; override;
  1202. end;
  1203. TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
  1204. procedure SetValues; override;
  1205. end;
  1206. TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
  1207. procedure SetValues; override;
  1208. end;
  1209. TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
  1210. procedure SetValues; override;
  1211. end;
  1212. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1213. TfdR3G3B2ub1 = class(TfdUniversalUB1)
  1214. procedure SetValues; override;
  1215. end;
  1216. TfdRGBX4us1 = class(TfdUniversalUS1)
  1217. procedure SetValues; override;
  1218. end;
  1219. TfdXRGB4us1 = class(TfdUniversalUS1)
  1220. procedure SetValues; override;
  1221. end;
  1222. TfdR5G6B5us1 = class(TfdUniversalUS1)
  1223. procedure SetValues; override;
  1224. end;
  1225. TfdRGB5X1us1 = class(TfdUniversalUS1)
  1226. procedure SetValues; override;
  1227. end;
  1228. TfdX1RGB5us1 = class(TfdUniversalUS1)
  1229. procedure SetValues; override;
  1230. end;
  1231. TfdRGB8ub3 = class(TfdRGBub3)
  1232. procedure SetValues; override;
  1233. end;
  1234. TfdRGBX8ui1 = class(TfdUniversalUI1)
  1235. procedure SetValues; override;
  1236. end;
  1237. TfdXRGB8ui1 = class(TfdUniversalUI1)
  1238. procedure SetValues; override;
  1239. end;
  1240. TfdRGB10X2ui1 = class(TfdUniversalUI1)
  1241. procedure SetValues; override;
  1242. end;
  1243. TfdX2RGB10ui1 = class(TfdUniversalUI1)
  1244. procedure SetValues; override;
  1245. end;
  1246. TfdRGB16us3 = class(TfdRGBus3)
  1247. procedure SetValues; override;
  1248. end;
  1249. TfdRGBA4us1 = class(TfdUniversalUS1)
  1250. procedure SetValues; override;
  1251. end;
  1252. TfdARGB4us1 = class(TfdUniversalUS1)
  1253. procedure SetValues; override;
  1254. end;
  1255. TfdRGB5A1us1 = class(TfdUniversalUS1)
  1256. procedure SetValues; override;
  1257. end;
  1258. TfdA1RGB5us1 = class(TfdUniversalUS1)
  1259. procedure SetValues; override;
  1260. end;
  1261. TfdRGBA8ui1 = class(TfdUniversalUI1)
  1262. procedure SetValues; override;
  1263. end;
  1264. TfdARGB8ui1 = class(TfdUniversalUI1)
  1265. procedure SetValues; override;
  1266. end;
  1267. TfdRGBA8ub4 = class(TfdRGBAub4)
  1268. procedure SetValues; override;
  1269. end;
  1270. TfdRGB10A2ui1 = class(TfdUniversalUI1)
  1271. procedure SetValues; override;
  1272. end;
  1273. TfdA2RGB10ui1 = class(TfdUniversalUI1)
  1274. procedure SetValues; override;
  1275. end;
  1276. TfdRGBA16us4 = class(TfdRGBAus4)
  1277. procedure SetValues; override;
  1278. end;
  1279. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1280. TfdBGRX4us1 = class(TfdUniversalUS1)
  1281. procedure SetValues; override;
  1282. end;
  1283. TfdXBGR4us1 = class(TfdUniversalUS1)
  1284. procedure SetValues; override;
  1285. end;
  1286. TfdB5G6R5us1 = class(TfdUniversalUS1)
  1287. procedure SetValues; override;
  1288. end;
  1289. TfdBGR5X1us1 = class(TfdUniversalUS1)
  1290. procedure SetValues; override;
  1291. end;
  1292. TfdX1BGR5us1 = class(TfdUniversalUS1)
  1293. procedure SetValues; override;
  1294. end;
  1295. TfdBGR8ub3 = class(TfdBGRub3)
  1296. procedure SetValues; override;
  1297. end;
  1298. TfdBGRX8ui1 = class(TfdUniversalUI1)
  1299. procedure SetValues; override;
  1300. end;
  1301. TfdXBGR8ui1 = class(TfdUniversalUI1)
  1302. procedure SetValues; override;
  1303. end;
  1304. TfdBGR10X2ui1 = class(TfdUniversalUI1)
  1305. procedure SetValues; override;
  1306. end;
  1307. TfdX2BGR10ui1 = class(TfdUniversalUI1)
  1308. procedure SetValues; override;
  1309. end;
  1310. TfdBGR16us3 = class(TfdBGRus3)
  1311. procedure SetValues; override;
  1312. end;
  1313. TfdBGRA4us1 = class(TfdUniversalUS1)
  1314. procedure SetValues; override;
  1315. end;
  1316. TfdABGR4us1 = class(TfdUniversalUS1)
  1317. procedure SetValues; override;
  1318. end;
  1319. TfdBGR5A1us1 = class(TfdUniversalUS1)
  1320. procedure SetValues; override;
  1321. end;
  1322. TfdA1BGR5us1 = class(TfdUniversalUS1)
  1323. procedure SetValues; override;
  1324. end;
  1325. TfdBGRA8ui1 = class(TfdUniversalUI1)
  1326. procedure SetValues; override;
  1327. end;
  1328. TfdABGR8ui1 = class(TfdUniversalUI1)
  1329. procedure SetValues; override;
  1330. end;
  1331. TfdBGRA8ub4 = class(TfdBGRAub4)
  1332. procedure SetValues; override;
  1333. end;
  1334. TfdBGR10A2ui1 = class(TfdUniversalUI1)
  1335. procedure SetValues; override;
  1336. end;
  1337. TfdA2BGR10ui1 = class(TfdUniversalUI1)
  1338. procedure SetValues; override;
  1339. end;
  1340. TfdBGRA16us4 = class(TfdBGRAus4)
  1341. procedure SetValues; override;
  1342. end;
  1343. TfdDepth16us1 = class(TfdDepthUS1)
  1344. procedure SetValues; override;
  1345. end;
  1346. TfdDepth24ui1 = class(TfdDepthUI1)
  1347. procedure SetValues; override;
  1348. end;
  1349. TfdDepth32ui1 = class(TfdDepthUI1)
  1350. procedure SetValues; override;
  1351. end;
  1352. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1353. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1354. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1355. procedure SetValues; override;
  1356. end;
  1357. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1358. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1359. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1360. procedure SetValues; override;
  1361. end;
  1362. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1363. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1364. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1365. procedure SetValues; override;
  1366. end;
  1367. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1368. TbmpBitfieldFormat = class(TFormatDescriptor)
  1369. public
  1370. procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
  1371. procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1372. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1373. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1374. end;
  1375. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1376. TbmpColorTableEnty = packed record
  1377. b, g, r, a: Byte;
  1378. end;
  1379. TbmpColorTable = array of TbmpColorTableEnty;
  1380. TbmpColorTableFormat = class(TFormatDescriptor)
  1381. private
  1382. fBitsPerPixel: Integer;
  1383. fColorTable: TbmpColorTable;
  1384. protected
  1385. procedure SetValues; override;
  1386. public
  1387. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1388. property BitsPerPixel: Integer read fBitsPerPixel write fBitsPerPixel;
  1389. procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1390. procedure CalcValues;
  1391. procedure CreateColorTable;
  1392. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1393. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1394. destructor Destroy; override;
  1395. end;
  1396. const
  1397. LUMINANCE_WEIGHT_R = 0.30;
  1398. LUMINANCE_WEIGHT_G = 0.59;
  1399. LUMINANCE_WEIGHT_B = 0.11;
  1400. ALPHA_WEIGHT_R = 0.30;
  1401. ALPHA_WEIGHT_G = 0.59;
  1402. ALPHA_WEIGHT_B = 0.11;
  1403. DEPTH_WEIGHT_R = 0.333333333;
  1404. DEPTH_WEIGHT_G = 0.333333333;
  1405. DEPTH_WEIGHT_B = 0.333333333;
  1406. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1407. TfdEmpty,
  1408. TfdAlpha4ub1,
  1409. TfdAlpha8ub1,
  1410. TfdAlpha16us1,
  1411. TfdLuminance4ub1,
  1412. TfdLuminance8ub1,
  1413. TfdLuminance16us1,
  1414. TfdLuminance4Alpha4ub2,
  1415. TfdLuminance6Alpha2ub2,
  1416. TfdLuminance8Alpha8ub2,
  1417. TfdLuminance12Alpha4us2,
  1418. TfdLuminance16Alpha16us2,
  1419. TfdR3G3B2ub1,
  1420. TfdRGBX4us1,
  1421. TfdXRGB4us1,
  1422. TfdR5G6B5us1,
  1423. TfdRGB5X1us1,
  1424. TfdX1RGB5us1,
  1425. TfdRGB8ub3,
  1426. TfdRGBX8ui1,
  1427. TfdXRGB8ui1,
  1428. TfdRGB10X2ui1,
  1429. TfdX2RGB10ui1,
  1430. TfdRGB16us3,
  1431. TfdRGBA4us1,
  1432. TfdARGB4us1,
  1433. TfdRGB5A1us1,
  1434. TfdA1RGB5us1,
  1435. TfdRGBA8ui1,
  1436. TfdARGB8ui1,
  1437. TfdRGBA8ub4,
  1438. TfdRGB10A2ui1,
  1439. TfdA2RGB10ui1,
  1440. TfdRGBA16us4,
  1441. TfdBGRX4us1,
  1442. TfdXBGR4us1,
  1443. TfdB5G6R5us1,
  1444. TfdBGR5X1us1,
  1445. TfdX1BGR5us1,
  1446. TfdBGR8ub3,
  1447. TfdBGRX8ui1,
  1448. TfdXBGR8ui1,
  1449. TfdBGR10X2ui1,
  1450. TfdX2BGR10ui1,
  1451. TfdBGR16us3,
  1452. TfdBGRA4us1,
  1453. TfdABGR4us1,
  1454. TfdBGR5A1us1,
  1455. TfdA1BGR5us1,
  1456. TfdBGRA8ui1,
  1457. TfdABGR8ui1,
  1458. TfdBGRA8ub4,
  1459. TfdBGR10A2ui1,
  1460. TfdA2BGR10ui1,
  1461. TfdBGRA16us4,
  1462. TfdDepth16us1,
  1463. TfdDepth24ui1,
  1464. TfdDepth32ui1,
  1465. TfdS3tcDtx1RGBA,
  1466. TfdS3tcDtx3RGBA,
  1467. TfdS3tcDtx5RGBA
  1468. );
  1469. var
  1470. FormatDescriptorCS: TCriticalSection;
  1471. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1473. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1474. begin
  1475. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1476. end;
  1477. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1478. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1479. begin
  1480. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1481. end;
  1482. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1483. function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
  1484. begin
  1485. result.Fields := [];
  1486. if (X >= 0) then
  1487. result.Fields := result.Fields + [ffX];
  1488. if (Y >= 0) then
  1489. result.Fields := result.Fields + [ffY];
  1490. result.X := Max(0, X);
  1491. result.Y := Max(0, Y);
  1492. end;
  1493. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1494. function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
  1495. begin
  1496. result := glBitmapSize(X, Y);
  1497. end;
  1498. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1499. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1500. begin
  1501. result.r := r;
  1502. result.g := g;
  1503. result.b := b;
  1504. result.a := a;
  1505. end;
  1506. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1507. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1508. begin
  1509. result.r := r;
  1510. result.g := g;
  1511. result.b := b;
  1512. result.a := a;
  1513. end;
  1514. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1515. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1516. begin
  1517. result.r := r;
  1518. result.g := g;
  1519. result.b := b;
  1520. result.a := a;
  1521. end;
  1522. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1523. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1524. var
  1525. i: Integer;
  1526. begin
  1527. result := false;
  1528. for i := 0 to high(r1.arr) do
  1529. if (r1.arr[i] <> r2.arr[i]) then
  1530. exit;
  1531. result := true;
  1532. end;
  1533. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1534. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1535. var
  1536. i: Integer;
  1537. begin
  1538. result := false;
  1539. for i := 0 to high(r1.arr) do
  1540. if (r1.arr[i] <> r2.arr[i]) then
  1541. exit;
  1542. result := true;
  1543. end;
  1544. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1545. function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
  1546. var
  1547. desc: TFormatDescriptor;
  1548. p, tmp: PByte;
  1549. x, y, i: Integer;
  1550. md: Pointer;
  1551. px: TglBitmapPixelData;
  1552. begin
  1553. result := nil;
  1554. desc := TFormatDescriptor.Get(aFormat);
  1555. if (desc.IsCompressed) or (desc.glFormat = 0) then
  1556. exit;
  1557. p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
  1558. md := desc.CreateMappingData;
  1559. try
  1560. tmp := p;
  1561. desc.PreparePixel(px);
  1562. for y := 0 to 4 do
  1563. for x := 0 to 4 do begin
  1564. px.Data := glBitmapRec4ui(0, 0, 0, 0);
  1565. for i := 0 to 3 do begin
  1566. if ((y < 3) and (y = i)) or
  1567. ((y = 3) and (i < 3)) or
  1568. ((y = 4) and (i = 3))
  1569. then
  1570. px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
  1571. else if ((y < 4) and (i = 3)) or
  1572. ((y = 4) and (i < 3))
  1573. then
  1574. px.Data.arr[i] := px.Range.arr[i]
  1575. else
  1576. px.Data.arr[i] := 0; //px.Range.arr[i];
  1577. end;
  1578. desc.Map(px, tmp, md);
  1579. end;
  1580. finally
  1581. desc.FreeMappingData(md);
  1582. end;
  1583. result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
  1584. result.FreeDataOnDestroy := true;
  1585. result.FreeDataAfterGenTexture := false;
  1586. result.SetFilter(GL_NEAREST, GL_NEAREST);
  1587. end;
  1588. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1589. function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
  1590. begin
  1591. result.r := r;
  1592. result.g := g;
  1593. result.b := b;
  1594. result.a := a;
  1595. end;
  1596. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1597. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1598. begin
  1599. result := [];
  1600. if (aFormat in [
  1601. //8bpp
  1602. tfAlpha4ub1, tfAlpha8ub1,
  1603. tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
  1604. //16bpp
  1605. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1606. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  1607. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
  1608. //24bpp
  1609. tfBGR8ub3, tfRGB8ub3,
  1610. //32bpp
  1611. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  1612. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
  1613. then
  1614. result := result + [ ftBMP ];
  1615. if (aFormat in [
  1616. //8bbp
  1617. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
  1618. //16bbp
  1619. tfAlpha16us1, tfLuminance16us1,
  1620. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1621. tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
  1622. //24bbp
  1623. tfBGR8ub3,
  1624. //32bbp
  1625. tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
  1626. tfDepth24ui1, tfDepth32ui1])
  1627. then
  1628. result := result + [ftTGA];
  1629. if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
  1630. result := result + [ftDDS];
  1631. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1632. if aFormat in [
  1633. tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
  1634. tfRGB8ub3, tfRGBA8ui1,
  1635. tfBGR8ub3, tfBGRA8ui1] then
  1636. result := result + [ftPNG];
  1637. {$ENDIF}
  1638. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1639. if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
  1640. result := result + [ftJPEG];
  1641. {$ENDIF}
  1642. end;
  1643. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1644. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1645. begin
  1646. while (aNumber and 1) = 0 do
  1647. aNumber := aNumber shr 1;
  1648. result := aNumber = 1;
  1649. end;
  1650. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1651. function GetTopMostBit(aBitSet: QWord): Integer;
  1652. begin
  1653. result := 0;
  1654. while aBitSet > 0 do begin
  1655. inc(result);
  1656. aBitSet := aBitSet shr 1;
  1657. end;
  1658. end;
  1659. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1660. function CountSetBits(aBitSet: QWord): Integer;
  1661. begin
  1662. result := 0;
  1663. while aBitSet > 0 do begin
  1664. if (aBitSet and 1) = 1 then
  1665. inc(result);
  1666. aBitSet := aBitSet shr 1;
  1667. end;
  1668. end;
  1669. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1670. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1671. begin
  1672. result := Trunc(
  1673. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1674. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1675. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1676. end;
  1677. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1678. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1679. begin
  1680. result := Trunc(
  1681. DEPTH_WEIGHT_R * aPixel.Data.r +
  1682. DEPTH_WEIGHT_G * aPixel.Data.g +
  1683. DEPTH_WEIGHT_B * aPixel.Data.b);
  1684. end;
  1685. {$IFDEF GLB_SDL_IMAGE}
  1686. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1687. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1688. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1689. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1690. begin
  1691. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1692. end;
  1693. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1694. begin
  1695. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1696. end;
  1697. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1698. begin
  1699. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1700. end;
  1701. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1702. begin
  1703. result := 0;
  1704. end;
  1705. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1706. begin
  1707. result := SDL_AllocRW;
  1708. if result = nil then
  1709. raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1710. result^.seek := glBitmapRWseek;
  1711. result^.read := glBitmapRWread;
  1712. result^.write := glBitmapRWwrite;
  1713. result^.close := glBitmapRWclose;
  1714. result^.unknown.data1 := Stream;
  1715. end;
  1716. {$ENDIF}
  1717. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1718. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1719. begin
  1720. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1721. end;
  1722. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1723. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1724. begin
  1725. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1726. end;
  1727. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1728. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1729. begin
  1730. glBitmapDefaultMipmap := aValue;
  1731. end;
  1732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1733. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1734. begin
  1735. glBitmapDefaultFormat := aFormat;
  1736. end;
  1737. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1738. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1739. begin
  1740. glBitmapDefaultFilterMin := aMin;
  1741. glBitmapDefaultFilterMag := aMag;
  1742. end;
  1743. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1744. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1745. begin
  1746. glBitmapDefaultWrapS := S;
  1747. glBitmapDefaultWrapT := T;
  1748. glBitmapDefaultWrapR := R;
  1749. end;
  1750. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1751. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1752. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1753. begin
  1754. glDefaultSwizzle[0] := r;
  1755. glDefaultSwizzle[1] := g;
  1756. glDefaultSwizzle[2] := b;
  1757. glDefaultSwizzle[3] := a;
  1758. end;
  1759. {$IFEND}
  1760. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1761. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1762. begin
  1763. result := glBitmapDefaultDeleteTextureOnFree;
  1764. end;
  1765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1766. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1767. begin
  1768. result := glBitmapDefaultFreeDataAfterGenTextures;
  1769. end;
  1770. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1771. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1772. begin
  1773. result := glBitmapDefaultMipmap;
  1774. end;
  1775. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1776. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1777. begin
  1778. result := glBitmapDefaultFormat;
  1779. end;
  1780. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1781. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1782. begin
  1783. aMin := glBitmapDefaultFilterMin;
  1784. aMag := glBitmapDefaultFilterMag;
  1785. end;
  1786. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1787. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1788. begin
  1789. S := glBitmapDefaultWrapS;
  1790. T := glBitmapDefaultWrapT;
  1791. R := glBitmapDefaultWrapR;
  1792. end;
  1793. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1794. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1795. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1796. begin
  1797. r := glDefaultSwizzle[0];
  1798. g := glDefaultSwizzle[1];
  1799. b := glDefaultSwizzle[2];
  1800. a := glDefaultSwizzle[3];
  1801. end;
  1802. {$ENDIF}
  1803. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1804. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1806. function TFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
  1807. var
  1808. w, h: Integer;
  1809. begin
  1810. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  1811. w := Max(1, aSize.X);
  1812. h := Max(1, aSize.Y);
  1813. result := GetSize(w, h);
  1814. end else
  1815. result := 0;
  1816. end;
  1817. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1818. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  1819. begin
  1820. result := 0;
  1821. if (aWidth <= 0) or (aHeight <= 0) then
  1822. exit;
  1823. result := Ceil(aWidth * aHeight * BytesPerPixel);
  1824. end;
  1825. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1826. function TFormatDescriptor.CreateMappingData: Pointer;
  1827. begin
  1828. result := nil;
  1829. end;
  1830. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1831. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  1832. begin
  1833. //DUMMY
  1834. end;
  1835. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1836. function TFormatDescriptor.IsEmpty: Boolean;
  1837. begin
  1838. result := (fFormat = tfEmpty);
  1839. end;
  1840. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1841. function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
  1842. var
  1843. i: Integer;
  1844. m: TglBitmapRec4ul;
  1845. begin
  1846. result := false;
  1847. if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
  1848. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  1849. m := Mask;
  1850. for i := 0 to 3 do
  1851. if (aMask.arr[i] <> m.arr[i]) then
  1852. exit;
  1853. result := true;
  1854. end;
  1855. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1856. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  1857. begin
  1858. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  1859. aPixel.Data := Range;
  1860. aPixel.Format := fFormat;
  1861. aPixel.Range := Range;
  1862. end;
  1863. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1864. constructor TFormatDescriptor.Create;
  1865. begin
  1866. inherited Create;
  1867. end;
  1868. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1869. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1870. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1871. procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1872. begin
  1873. aData^ := aPixel.Data.a;
  1874. inc(aData);
  1875. end;
  1876. procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1877. begin
  1878. aPixel.Data.r := 0;
  1879. aPixel.Data.g := 0;
  1880. aPixel.Data.b := 0;
  1881. aPixel.Data.a := aData^;
  1882. inc(aData);
  1883. end;
  1884. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1885. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1886. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1887. procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1888. begin
  1889. aData^ := LuminanceWeight(aPixel);
  1890. inc(aData);
  1891. end;
  1892. procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1893. begin
  1894. aPixel.Data.r := aData^;
  1895. aPixel.Data.g := aData^;
  1896. aPixel.Data.b := aData^;
  1897. aPixel.Data.a := 0;
  1898. inc(aData);
  1899. end;
  1900. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1901. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1903. procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1904. var
  1905. i: Integer;
  1906. begin
  1907. aData^ := 0;
  1908. for i := 0 to 3 do
  1909. if (Range.arr[i] > 0) then
  1910. aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  1911. inc(aData);
  1912. end;
  1913. procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1914. var
  1915. i: Integer;
  1916. begin
  1917. for i := 0 to 3 do
  1918. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
  1919. inc(aData);
  1920. end;
  1921. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1922. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1923. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1924. procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1925. begin
  1926. inherited Map(aPixel, aData, aMapData);
  1927. aData^ := aPixel.Data.a;
  1928. inc(aData);
  1929. end;
  1930. procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1931. begin
  1932. inherited Unmap(aData, aPixel, aMapData);
  1933. aPixel.Data.a := aData^;
  1934. inc(aData);
  1935. end;
  1936. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1937. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1938. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1939. procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1940. begin
  1941. aData^ := aPixel.Data.r;
  1942. inc(aData);
  1943. aData^ := aPixel.Data.g;
  1944. inc(aData);
  1945. aData^ := aPixel.Data.b;
  1946. inc(aData);
  1947. end;
  1948. procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1949. begin
  1950. aPixel.Data.r := aData^;
  1951. inc(aData);
  1952. aPixel.Data.g := aData^;
  1953. inc(aData);
  1954. aPixel.Data.b := aData^;
  1955. inc(aData);
  1956. aPixel.Data.a := 0;
  1957. end;
  1958. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1959. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1960. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1961. procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1962. begin
  1963. aData^ := aPixel.Data.b;
  1964. inc(aData);
  1965. aData^ := aPixel.Data.g;
  1966. inc(aData);
  1967. aData^ := aPixel.Data.r;
  1968. inc(aData);
  1969. end;
  1970. procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1971. begin
  1972. aPixel.Data.b := aData^;
  1973. inc(aData);
  1974. aPixel.Data.g := aData^;
  1975. inc(aData);
  1976. aPixel.Data.r := aData^;
  1977. inc(aData);
  1978. aPixel.Data.a := 0;
  1979. end;
  1980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1981. //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1982. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1983. procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1984. begin
  1985. inherited Map(aPixel, aData, aMapData);
  1986. aData^ := aPixel.Data.a;
  1987. inc(aData);
  1988. end;
  1989. procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1990. begin
  1991. inherited Unmap(aData, aPixel, aMapData);
  1992. aPixel.Data.a := aData^;
  1993. inc(aData);
  1994. end;
  1995. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1996. //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1997. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1998. procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1999. begin
  2000. inherited Map(aPixel, aData, aMapData);
  2001. aData^ := aPixel.Data.a;
  2002. inc(aData);
  2003. end;
  2004. procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2005. begin
  2006. inherited Unmap(aData, aPixel, aMapData);
  2007. aPixel.Data.a := aData^;
  2008. inc(aData);
  2009. end;
  2010. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2011. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2012. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2013. procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2014. begin
  2015. PWord(aData)^ := aPixel.Data.a;
  2016. inc(aData, 2);
  2017. end;
  2018. procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2019. begin
  2020. aPixel.Data.r := 0;
  2021. aPixel.Data.g := 0;
  2022. aPixel.Data.b := 0;
  2023. aPixel.Data.a := PWord(aData)^;
  2024. inc(aData, 2);
  2025. end;
  2026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2027. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2028. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2029. procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2030. begin
  2031. PWord(aData)^ := LuminanceWeight(aPixel);
  2032. inc(aData, 2);
  2033. end;
  2034. procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2035. begin
  2036. aPixel.Data.r := PWord(aData)^;
  2037. aPixel.Data.g := PWord(aData)^;
  2038. aPixel.Data.b := PWord(aData)^;
  2039. aPixel.Data.a := 0;
  2040. inc(aData, 2);
  2041. end;
  2042. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2043. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2044. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2045. procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2046. var
  2047. i: Integer;
  2048. begin
  2049. PWord(aData)^ := 0;
  2050. for i := 0 to 3 do
  2051. if (Range.arr[i] > 0) then
  2052. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2053. inc(aData, 2);
  2054. end;
  2055. procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2056. var
  2057. i: Integer;
  2058. begin
  2059. for i := 0 to 3 do
  2060. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2061. inc(aData, 2);
  2062. end;
  2063. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2064. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2065. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2066. procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2067. begin
  2068. PWord(aData)^ := DepthWeight(aPixel);
  2069. inc(aData, 2);
  2070. end;
  2071. procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2072. begin
  2073. aPixel.Data.r := PWord(aData)^;
  2074. aPixel.Data.g := PWord(aData)^;
  2075. aPixel.Data.b := PWord(aData)^;
  2076. aPixel.Data.a := PWord(aData)^;;
  2077. inc(aData, 2);
  2078. end;
  2079. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2080. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2081. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2082. procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2083. begin
  2084. inherited Map(aPixel, aData, aMapData);
  2085. PWord(aData)^ := aPixel.Data.a;
  2086. inc(aData, 2);
  2087. end;
  2088. procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2089. begin
  2090. inherited Unmap(aData, aPixel, aMapData);
  2091. aPixel.Data.a := PWord(aData)^;
  2092. inc(aData, 2);
  2093. end;
  2094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2095. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2096. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2097. procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2098. begin
  2099. PWord(aData)^ := aPixel.Data.r;
  2100. inc(aData, 2);
  2101. PWord(aData)^ := aPixel.Data.g;
  2102. inc(aData, 2);
  2103. PWord(aData)^ := aPixel.Data.b;
  2104. inc(aData, 2);
  2105. end;
  2106. procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2107. begin
  2108. aPixel.Data.r := PWord(aData)^;
  2109. inc(aData, 2);
  2110. aPixel.Data.g := PWord(aData)^;
  2111. inc(aData, 2);
  2112. aPixel.Data.b := PWord(aData)^;
  2113. inc(aData, 2);
  2114. aPixel.Data.a := 0;
  2115. end;
  2116. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2117. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2118. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2119. procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2120. begin
  2121. PWord(aData)^ := aPixel.Data.b;
  2122. inc(aData, 2);
  2123. PWord(aData)^ := aPixel.Data.g;
  2124. inc(aData, 2);
  2125. PWord(aData)^ := aPixel.Data.r;
  2126. inc(aData, 2);
  2127. end;
  2128. procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2129. begin
  2130. aPixel.Data.b := PWord(aData)^;
  2131. inc(aData, 2);
  2132. aPixel.Data.g := PWord(aData)^;
  2133. inc(aData, 2);
  2134. aPixel.Data.r := PWord(aData)^;
  2135. inc(aData, 2);
  2136. aPixel.Data.a := 0;
  2137. end;
  2138. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2139. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2140. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2141. procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2142. begin
  2143. inherited Map(aPixel, aData, aMapData);
  2144. PWord(aData)^ := aPixel.Data.a;
  2145. inc(aData, 2);
  2146. end;
  2147. procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2148. begin
  2149. inherited Unmap(aData, aPixel, aMapData);
  2150. aPixel.Data.a := PWord(aData)^;
  2151. inc(aData, 2);
  2152. end;
  2153. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2154. //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2155. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2156. procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2157. begin
  2158. PWord(aData)^ := aPixel.Data.a;
  2159. inc(aData, 2);
  2160. inherited Map(aPixel, aData, aMapData);
  2161. end;
  2162. procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2163. begin
  2164. aPixel.Data.a := PWord(aData)^;
  2165. inc(aData, 2);
  2166. inherited Unmap(aData, aPixel, aMapData);
  2167. end;
  2168. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2169. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2170. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2171. procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2172. begin
  2173. inherited Map(aPixel, aData, aMapData);
  2174. PWord(aData)^ := aPixel.Data.a;
  2175. inc(aData, 2);
  2176. end;
  2177. procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2178. begin
  2179. inherited Unmap(aData, aPixel, aMapData);
  2180. aPixel.Data.a := PWord(aData)^;
  2181. inc(aData, 2);
  2182. end;
  2183. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2184. //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2186. procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2187. begin
  2188. PWord(aData)^ := aPixel.Data.a;
  2189. inc(aData, 2);
  2190. inherited Map(aPixel, aData, aMapData);
  2191. end;
  2192. procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2193. begin
  2194. aPixel.Data.a := PWord(aData)^;
  2195. inc(aData, 2);
  2196. inherited Unmap(aData, aPixel, aMapData);
  2197. end;
  2198. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2199. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2200. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2201. procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2202. var
  2203. i: Integer;
  2204. begin
  2205. PCardinal(aData)^ := 0;
  2206. for i := 0 to 3 do
  2207. if (Range.arr[i] > 0) then
  2208. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2209. inc(aData, 4);
  2210. end;
  2211. procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2212. var
  2213. i: Integer;
  2214. begin
  2215. for i := 0 to 3 do
  2216. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2217. inc(aData, 2);
  2218. end;
  2219. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2220. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2221. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2222. procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2223. begin
  2224. PCardinal(aData)^ := DepthWeight(aPixel);
  2225. inc(aData, 4);
  2226. end;
  2227. procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2228. begin
  2229. aPixel.Data.r := PCardinal(aData)^;
  2230. aPixel.Data.g := PCardinal(aData)^;
  2231. aPixel.Data.b := PCardinal(aData)^;
  2232. aPixel.Data.a := PCardinal(aData)^;
  2233. inc(aData, 4);
  2234. end;
  2235. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2236. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2237. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2238. procedure TfdAlpha4ub1.SetValues;
  2239. begin
  2240. inherited SetValues;
  2241. fBitsPerPixel := 8;
  2242. fFormat := tfAlpha4ub1;
  2243. fWithAlpha := tfAlpha4ub1;
  2244. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2245. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2246. {$IFNDEF OPENGL_ES}
  2247. fOpenGLFormat := tfAlpha4ub1;
  2248. fglFormat := GL_ALPHA;
  2249. fglInternalFormat := GL_ALPHA4;
  2250. fglDataFormat := GL_UNSIGNED_BYTE;
  2251. {$ELSE}
  2252. fOpenGLFormat := tfAlpha8ub1;
  2253. {$ENDIF}
  2254. end;
  2255. procedure TfdAlpha8ub1.SetValues;
  2256. begin
  2257. inherited SetValues;
  2258. fBitsPerPixel := 8;
  2259. fFormat := tfAlpha8ub1;
  2260. fWithAlpha := tfAlpha8ub1;
  2261. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2262. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2263. fOpenGLFormat := tfAlpha8ub1;
  2264. fglFormat := GL_ALPHA;
  2265. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
  2266. fglDataFormat := GL_UNSIGNED_BYTE;
  2267. end;
  2268. procedure TfdAlpha16us1.SetValues;
  2269. begin
  2270. inherited SetValues;
  2271. fBitsPerPixel := 16;
  2272. fFormat := tfAlpha16us1;
  2273. fWithAlpha := tfAlpha16us1;
  2274. fPrecision := glBitmapRec4ub(0, 0, 0, 16);
  2275. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2276. {$IFNDEF OPENGL_ES}
  2277. fOpenGLFormat := tfAlpha16us1;
  2278. fglFormat := GL_ALPHA;
  2279. fglInternalFormat := GL_ALPHA16;
  2280. fglDataFormat := GL_UNSIGNED_SHORT;
  2281. {$ELSE}
  2282. fOpenGLFormat := tfAlpha8ub1;
  2283. {$ENDIF}
  2284. end;
  2285. procedure TfdLuminance4ub1.SetValues;
  2286. begin
  2287. inherited SetValues;
  2288. fBitsPerPixel := 8;
  2289. fFormat := tfLuminance4ub1;
  2290. fWithAlpha := tfLuminance4Alpha4ub2;
  2291. fWithoutAlpha := tfLuminance4ub1;
  2292. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2293. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2294. {$IFNDEF OPENGL_ES}
  2295. fOpenGLFormat := tfLuminance4ub1;
  2296. fglFormat := GL_LUMINANCE;
  2297. fglInternalFormat := GL_LUMINANCE4;
  2298. fglDataFormat := GL_UNSIGNED_BYTE;
  2299. {$ELSE}
  2300. fOpenGLFormat := tfLuminance8ub1;
  2301. {$ENDIF}
  2302. end;
  2303. procedure TfdLuminance8ub1.SetValues;
  2304. begin
  2305. inherited SetValues;
  2306. fBitsPerPixel := 8;
  2307. fFormat := tfLuminance8ub1;
  2308. fWithAlpha := tfLuminance8Alpha8ub2;
  2309. fWithoutAlpha := tfLuminance8ub1;
  2310. fOpenGLFormat := tfLuminance8ub1;
  2311. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2312. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2313. fglFormat := GL_LUMINANCE;
  2314. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
  2315. fglDataFormat := GL_UNSIGNED_BYTE;
  2316. end;
  2317. procedure TfdLuminance16us1.SetValues;
  2318. begin
  2319. inherited SetValues;
  2320. fBitsPerPixel := 16;
  2321. fFormat := tfLuminance16us1;
  2322. fWithAlpha := tfLuminance16Alpha16us2;
  2323. fWithoutAlpha := tfLuminance16us1;
  2324. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2325. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  2326. {$IFNDEF OPENGL_ES}
  2327. fOpenGLFormat := tfLuminance16us1;
  2328. fglFormat := GL_LUMINANCE;
  2329. fglInternalFormat := GL_LUMINANCE16;
  2330. fglDataFormat := GL_UNSIGNED_SHORT;
  2331. {$ELSE}
  2332. fOpenGLFormat := tfLuminance8ub1;
  2333. {$ENDIF}
  2334. end;
  2335. procedure TfdLuminance4Alpha4ub2.SetValues;
  2336. begin
  2337. inherited SetValues;
  2338. fBitsPerPixel := 16;
  2339. fFormat := tfLuminance4Alpha4ub2;
  2340. fWithAlpha := tfLuminance4Alpha4ub2;
  2341. fWithoutAlpha := tfLuminance4ub1;
  2342. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2343. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2344. {$IFNDEF OPENGL_ES}
  2345. fOpenGLFormat := tfLuminance4Alpha4ub2;
  2346. fglFormat := GL_LUMINANCE_ALPHA;
  2347. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2348. fglDataFormat := GL_UNSIGNED_BYTE;
  2349. {$ELSE}
  2350. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2351. {$ENDIF}
  2352. end;
  2353. procedure TfdLuminance6Alpha2ub2.SetValues;
  2354. begin
  2355. inherited SetValues;
  2356. fBitsPerPixel := 16;
  2357. fFormat := tfLuminance6Alpha2ub2;
  2358. fWithAlpha := tfLuminance6Alpha2ub2;
  2359. fWithoutAlpha := tfLuminance8ub1;
  2360. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2361. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2362. {$IFNDEF OPENGL_ES}
  2363. fOpenGLFormat := tfLuminance6Alpha2ub2;
  2364. fglFormat := GL_LUMINANCE_ALPHA;
  2365. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2366. fglDataFormat := GL_UNSIGNED_BYTE;
  2367. {$ELSE}
  2368. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2369. {$ENDIF}
  2370. end;
  2371. procedure TfdLuminance8Alpha8ub2.SetValues;
  2372. begin
  2373. inherited SetValues;
  2374. fBitsPerPixel := 16;
  2375. fFormat := tfLuminance8Alpha8ub2;
  2376. fWithAlpha := tfLuminance8Alpha8ub2;
  2377. fWithoutAlpha := tfLuminance8ub1;
  2378. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2379. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2380. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2381. fglFormat := GL_LUMINANCE_ALPHA;
  2382. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
  2383. fglDataFormat := GL_UNSIGNED_BYTE;
  2384. end;
  2385. procedure TfdLuminance12Alpha4us2.SetValues;
  2386. begin
  2387. inherited SetValues;
  2388. fBitsPerPixel := 32;
  2389. fFormat := tfLuminance12Alpha4us2;
  2390. fWithAlpha := tfLuminance12Alpha4us2;
  2391. fWithoutAlpha := tfLuminance16us1;
  2392. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2393. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2394. {$IFNDEF OPENGL_ES}
  2395. fOpenGLFormat := tfLuminance12Alpha4us2;
  2396. fglFormat := GL_LUMINANCE_ALPHA;
  2397. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2398. fglDataFormat := GL_UNSIGNED_SHORT;
  2399. {$ELSE}
  2400. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2401. {$ENDIF}
  2402. end;
  2403. procedure TfdLuminance16Alpha16us2.SetValues;
  2404. begin
  2405. inherited SetValues;
  2406. fBitsPerPixel := 32;
  2407. fFormat := tfLuminance16Alpha16us2;
  2408. fWithAlpha := tfLuminance16Alpha16us2;
  2409. fWithoutAlpha := tfLuminance16us1;
  2410. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2411. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2412. {$IFNDEF OPENGL_ES}
  2413. fOpenGLFormat := tfLuminance16Alpha16us2;
  2414. fglFormat := GL_LUMINANCE_ALPHA;
  2415. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2416. fglDataFormat := GL_UNSIGNED_SHORT;
  2417. {$ELSE}
  2418. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2419. {$ENDIF}
  2420. end;
  2421. procedure TfdR3G3B2ub1.SetValues;
  2422. begin
  2423. inherited SetValues;
  2424. fBitsPerPixel := 8;
  2425. fFormat := tfR3G3B2ub1;
  2426. fWithAlpha := tfRGBA4us1;
  2427. fWithoutAlpha := tfR3G3B2ub1;
  2428. fRGBInverted := tfEmpty;
  2429. fPrecision := glBitmapRec4ub(3, 3, 2, 0);
  2430. fShift := glBitmapRec4ub(5, 2, 0, 0);
  2431. {$IFNDEF OPENGL_ES}
  2432. fOpenGLFormat := tfR3G3B2ub1;
  2433. fglFormat := GL_RGB;
  2434. fglInternalFormat := GL_R3_G3_B2;
  2435. fglDataFormat := GL_UNSIGNED_BYTE_3_3_2;
  2436. {$ELSE}
  2437. fOpenGLFormat := tfR5G6B5us1;
  2438. {$ENDIF}
  2439. end;
  2440. procedure TfdRGBX4us1.SetValues;
  2441. begin
  2442. inherited SetValues;
  2443. fBitsPerPixel := 16;
  2444. fFormat := tfRGBX4us1;
  2445. fWithAlpha := tfRGBA4us1;
  2446. fWithoutAlpha := tfRGBX4us1;
  2447. fRGBInverted := tfBGRX4us1;
  2448. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2449. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2450. {$IFNDEF OPENGL_ES}
  2451. fOpenGLFormat := tfRGBX4us1;
  2452. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2453. fglInternalFormat := GL_RGB4;
  2454. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2455. {$ELSE}
  2456. fOpenGLFormat := tfR5G6B5us1;
  2457. {$ENDIF}
  2458. end;
  2459. procedure TfdXRGB4us1.SetValues;
  2460. begin
  2461. inherited SetValues;
  2462. fBitsPerPixel := 16;
  2463. fFormat := tfXRGB4us1;
  2464. fWithAlpha := tfARGB4us1;
  2465. fWithoutAlpha := tfXRGB4us1;
  2466. fRGBInverted := tfXBGR4us1;
  2467. fPrecision := glBitmapRec4ub(4, 4, 4, 0);
  2468. fShift := glBitmapRec4ub(8, 4, 0, 0);
  2469. {$IFNDEF OPENGL_ES}
  2470. fOpenGLFormat := tfXRGB4us1;
  2471. fglFormat := GL_BGRA;
  2472. fglInternalFormat := GL_RGB4;
  2473. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2474. {$ELSE}
  2475. fOpenGLFormat := tfR5G6B5us1;
  2476. {$ENDIF}
  2477. end;
  2478. procedure TfdR5G6B5us1.SetValues;
  2479. begin
  2480. inherited SetValues;
  2481. fBitsPerPixel := 16;
  2482. fFormat := tfR5G6B5us1;
  2483. fWithAlpha := tfRGB5A1us1;
  2484. fWithoutAlpha := tfR5G6B5us1;
  2485. fRGBInverted := tfB5G6R5us1;
  2486. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2487. fShift := glBitmapRec4ub(11, 5, 0, 0);
  2488. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  2489. fOpenGLFormat := tfR5G6B5us1;
  2490. fglFormat := GL_RGB;
  2491. fglInternalFormat := GL_RGB565;
  2492. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2493. {$ELSE}
  2494. fOpenGLFormat := tfRGB8ub3;
  2495. {$IFEND}
  2496. end;
  2497. procedure TfdRGB5X1us1.SetValues;
  2498. begin
  2499. inherited SetValues;
  2500. fBitsPerPixel := 16;
  2501. fFormat := tfRGB5X1us1;
  2502. fWithAlpha := tfRGB5A1us1;
  2503. fWithoutAlpha := tfRGB5X1us1;
  2504. fRGBInverted := tfBGR5X1us1;
  2505. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2506. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2507. {$IFNDEF OPENGL_ES}
  2508. fOpenGLFormat := tfRGB5X1us1;
  2509. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2510. fglInternalFormat := GL_RGB5;
  2511. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2512. {$ELSE}
  2513. fOpenGLFormat := tfR5G6B5us1;
  2514. {$ENDIF}
  2515. end;
  2516. procedure TfdX1RGB5us1.SetValues;
  2517. begin
  2518. inherited SetValues;
  2519. fBitsPerPixel := 16;
  2520. fFormat := tfX1RGB5us1;
  2521. fWithAlpha := tfA1RGB5us1;
  2522. fWithoutAlpha := tfX1RGB5us1;
  2523. fRGBInverted := tfX1BGR5us1;
  2524. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2525. fShift := glBitmapRec4ub(10, 5, 0, 0);
  2526. {$IFNDEF OPENGL_ES}
  2527. fOpenGLFormat := tfX1RGB5us1;
  2528. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2529. fglInternalFormat := GL_RGB5;
  2530. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2531. {$ELSE}
  2532. fOpenGLFormat := tfR5G6B5us1;
  2533. {$ENDIF}
  2534. end;
  2535. procedure TfdRGB8ub3.SetValues;
  2536. begin
  2537. inherited SetValues;
  2538. fBitsPerPixel := 24;
  2539. fFormat := tfRGB8ub3;
  2540. fWithAlpha := tfRGBA8ub4;
  2541. fWithoutAlpha := tfRGB8ub3;
  2542. fRGBInverted := tfBGR8ub3;
  2543. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2544. fShift := glBitmapRec4ub(0, 8, 16, 0);
  2545. fOpenGLFormat := tfRGB8ub3;
  2546. fglFormat := GL_RGB;
  2547. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
  2548. fglDataFormat := GL_UNSIGNED_BYTE;
  2549. end;
  2550. procedure TfdRGBX8ui1.SetValues;
  2551. begin
  2552. inherited SetValues;
  2553. fBitsPerPixel := 32;
  2554. fFormat := tfRGBX8ui1;
  2555. fWithAlpha := tfRGBA8ui1;
  2556. fWithoutAlpha := tfRGBX8ui1;
  2557. fRGBInverted := tfBGRX8ui1;
  2558. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2559. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2560. {$IFNDEF OPENGL_ES}
  2561. fOpenGLFormat := tfRGBX8ui1;
  2562. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2563. fglInternalFormat := GL_RGB8;
  2564. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2565. {$ELSE}
  2566. fOpenGLFormat := tfRGB8ub3;
  2567. {$ENDIF}
  2568. end;
  2569. procedure TfdXRGB8ui1.SetValues;
  2570. begin
  2571. inherited SetValues;
  2572. fBitsPerPixel := 32;
  2573. fFormat := tfXRGB8ui1;
  2574. fWithAlpha := tfXRGB8ui1;
  2575. fWithoutAlpha := tfXRGB8ui1;
  2576. fOpenGLFormat := tfXRGB8ui1;
  2577. fRGBInverted := tfXBGR8ui1;
  2578. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2579. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2580. {$IFNDEF OPENGL_ES}
  2581. fOpenGLFormat := tfXRGB8ui1;
  2582. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2583. fglInternalFormat := GL_RGB8;
  2584. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2585. {$ELSE}
  2586. fOpenGLFormat := tfRGB8ub3;
  2587. {$ENDIF}
  2588. end;
  2589. procedure TfdRGB10X2ui1.SetValues;
  2590. begin
  2591. inherited SetValues;
  2592. fBitsPerPixel := 32;
  2593. fFormat := tfRGB10X2ui1;
  2594. fWithAlpha := tfRGB10A2ui1;
  2595. fWithoutAlpha := tfRGB10X2ui1;
  2596. fRGBInverted := tfBGR10X2ui1;
  2597. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2598. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2599. {$IFNDEF OPENGL_ES}
  2600. fOpenGLFormat := tfRGB10X2ui1;
  2601. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2602. fglInternalFormat := GL_RGB10;
  2603. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2604. {$ELSE}
  2605. fOpenGLFormat := tfRGB16us3;
  2606. {$ENDIF}
  2607. end;
  2608. procedure TfdX2RGB10ui1.SetValues;
  2609. begin
  2610. inherited SetValues;
  2611. fBitsPerPixel := 32;
  2612. fFormat := tfX2RGB10ui1;
  2613. fWithAlpha := tfA2RGB10ui1;
  2614. fWithoutAlpha := tfX2RGB10ui1;
  2615. fRGBInverted := tfX2BGR10ui1;
  2616. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2617. fShift := glBitmapRec4ub(20, 10, 0, 0);
  2618. {$IFNDEF OPENGL_ES}
  2619. fOpenGLFormat := tfX2RGB10ui1;
  2620. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2621. fglInternalFormat := GL_RGB10;
  2622. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2623. {$ELSE}
  2624. fOpenGLFormat := tfRGB16us3;
  2625. {$ENDIF}
  2626. end;
  2627. procedure TfdRGB16us3.SetValues;
  2628. begin
  2629. inherited SetValues;
  2630. fBitsPerPixel := 48;
  2631. fFormat := tfRGB16us3;
  2632. fWithAlpha := tfRGBA16us4;
  2633. fWithoutAlpha := tfRGB16us3;
  2634. fRGBInverted := tfBGR16us3;
  2635. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2636. fShift := glBitmapRec4ub( 0, 16, 32, 0);
  2637. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2638. fOpenGLFormat := tfRGB16us3;
  2639. fglFormat := GL_RGB;
  2640. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
  2641. fglDataFormat := GL_UNSIGNED_SHORT;
  2642. {$ELSE}
  2643. fOpenGLFormat := tfRGB8ub3;
  2644. {$IFEND}
  2645. end;
  2646. procedure TfdRGBA4us1.SetValues;
  2647. begin
  2648. inherited SetValues;
  2649. fBitsPerPixel := 16;
  2650. fFormat := tfRGBA4us1;
  2651. fWithAlpha := tfRGBA4us1;
  2652. fWithoutAlpha := tfRGBX4us1;
  2653. fOpenGLFormat := tfRGBA4us1;
  2654. fRGBInverted := tfBGRA4us1;
  2655. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2656. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2657. fglFormat := GL_RGBA;
  2658. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2659. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2660. end;
  2661. procedure TfdARGB4us1.SetValues;
  2662. begin
  2663. inherited SetValues;
  2664. fBitsPerPixel := 16;
  2665. fFormat := tfARGB4us1;
  2666. fWithAlpha := tfARGB4us1;
  2667. fWithoutAlpha := tfXRGB4us1;
  2668. fRGBInverted := tfABGR4us1;
  2669. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2670. fShift := glBitmapRec4ub( 8, 4, 0, 12);
  2671. {$IFNDEF OPENGL_ES}
  2672. fOpenGLFormat := tfARGB4us1;
  2673. fglFormat := GL_BGRA;
  2674. fglInternalFormat := GL_RGBA4;
  2675. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2676. {$ELSE}
  2677. fOpenGLFormat := tfRGBA4us1;
  2678. {$ENDIF}
  2679. end;
  2680. procedure TfdRGB5A1us1.SetValues;
  2681. begin
  2682. inherited SetValues;
  2683. fBitsPerPixel := 16;
  2684. fFormat := tfRGB5A1us1;
  2685. fWithAlpha := tfRGB5A1us1;
  2686. fWithoutAlpha := tfRGB5X1us1;
  2687. fOpenGLFormat := tfRGB5A1us1;
  2688. fRGBInverted := tfBGR5A1us1;
  2689. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2690. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2691. fglFormat := GL_RGBA;
  2692. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
  2693. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2694. end;
  2695. procedure TfdA1RGB5us1.SetValues;
  2696. begin
  2697. inherited SetValues;
  2698. fBitsPerPixel := 16;
  2699. fFormat := tfA1RGB5us1;
  2700. fWithAlpha := tfA1RGB5us1;
  2701. fWithoutAlpha := tfX1RGB5us1;
  2702. fRGBInverted := tfA1BGR5us1;
  2703. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2704. fShift := glBitmapRec4ub(10, 5, 0, 15);
  2705. {$IFNDEF OPENGL_ES}
  2706. fOpenGLFormat := tfA1RGB5us1;
  2707. fglFormat := GL_BGRA;
  2708. fglInternalFormat := GL_RGB5_A1;
  2709. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2710. {$ELSE}
  2711. fOpenGLFormat := tfRGB5A1us1;
  2712. {$ENDIF}
  2713. end;
  2714. procedure TfdRGBA8ui1.SetValues;
  2715. begin
  2716. inherited SetValues;
  2717. fBitsPerPixel := 32;
  2718. fFormat := tfRGBA8ui1;
  2719. fWithAlpha := tfRGBA8ui1;
  2720. fWithoutAlpha := tfRGBX8ui1;
  2721. fRGBInverted := tfBGRA8ui1;
  2722. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2723. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2724. {$IFNDEF OPENGL_ES}
  2725. fOpenGLFormat := tfRGBA8ui1;
  2726. fglFormat := GL_RGBA;
  2727. fglInternalFormat := GL_RGBA8;
  2728. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2729. {$ELSE}
  2730. fOpenGLFormat := tfRGBA8ub4;
  2731. {$ENDIF}
  2732. end;
  2733. procedure TfdARGB8ui1.SetValues;
  2734. begin
  2735. inherited SetValues;
  2736. fBitsPerPixel := 32;
  2737. fFormat := tfARGB8ui1;
  2738. fWithAlpha := tfARGB8ui1;
  2739. fWithoutAlpha := tfXRGB8ui1;
  2740. fRGBInverted := tfABGR8ui1;
  2741. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2742. fShift := glBitmapRec4ub(16, 8, 0, 24);
  2743. {$IFNDEF OPENGL_ES}
  2744. fOpenGLFormat := tfARGB8ui1;
  2745. fglFormat := GL_BGRA;
  2746. fglInternalFormat := GL_RGBA8;
  2747. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2748. {$ELSE}
  2749. fOpenGLFormat := tfRGBA8ub4;
  2750. {$ENDIF}
  2751. end;
  2752. procedure TfdRGBA8ub4.SetValues;
  2753. begin
  2754. inherited SetValues;
  2755. fBitsPerPixel := 32;
  2756. fFormat := tfRGBA8ub4;
  2757. fWithAlpha := tfRGBA8ub4;
  2758. fWithoutAlpha := tfRGB8ub3;
  2759. fOpenGLFormat := tfRGBA8ub4;
  2760. fRGBInverted := tfBGRA8ub4;
  2761. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2762. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  2763. fglFormat := GL_RGBA;
  2764. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2765. fglDataFormat := GL_UNSIGNED_BYTE;
  2766. end;
  2767. procedure TfdRGB10A2ui1.SetValues;
  2768. begin
  2769. inherited SetValues;
  2770. fBitsPerPixel := 32;
  2771. fFormat := tfRGB10A2ui1;
  2772. fWithAlpha := tfRGB10A2ui1;
  2773. fWithoutAlpha := tfRGB10X2ui1;
  2774. fRGBInverted := tfBGR10A2ui1;
  2775. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2776. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2777. {$IFNDEF OPENGL_ES}
  2778. fOpenGLFormat := tfRGB10A2ui1;
  2779. fglFormat := GL_RGBA;
  2780. fglInternalFormat := GL_RGB10_A2;
  2781. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2782. {$ELSE}
  2783. fOpenGLFormat := tfA2RGB10ui1;
  2784. {$ENDIF}
  2785. end;
  2786. procedure TfdA2RGB10ui1.SetValues;
  2787. begin
  2788. inherited SetValues;
  2789. fBitsPerPixel := 32;
  2790. fFormat := tfA2RGB10ui1;
  2791. fWithAlpha := tfA2RGB10ui1;
  2792. fWithoutAlpha := tfX2RGB10ui1;
  2793. fRGBInverted := tfA2BGR10ui1;
  2794. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2795. fShift := glBitmapRec4ub(20, 10, 0, 30);
  2796. {$IF NOT DEFINED(OPENGL_ES)}
  2797. fOpenGLFormat := tfA2RGB10ui1;
  2798. fglFormat := GL_BGRA;
  2799. fglInternalFormat := GL_RGB10_A2;
  2800. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2801. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  2802. fOpenGLFormat := tfA2RGB10ui1;
  2803. fglFormat := GL_RGBA;
  2804. fglInternalFormat := GL_RGB10_A2;
  2805. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2806. {$ELSE}
  2807. fOpenGLFormat := tfRGBA8ui1;
  2808. {$IFEND}
  2809. end;
  2810. procedure TfdRGBA16us4.SetValues;
  2811. begin
  2812. inherited SetValues;
  2813. fBitsPerPixel := 64;
  2814. fFormat := tfRGBA16us4;
  2815. fWithAlpha := tfRGBA16us4;
  2816. fWithoutAlpha := tfRGB16us3;
  2817. fRGBInverted := tfBGRA16us4;
  2818. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2819. fShift := glBitmapRec4ub( 0, 16, 32, 48);
  2820. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2821. fOpenGLFormat := tfRGBA16us4;
  2822. fglFormat := GL_RGBA;
  2823. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
  2824. fglDataFormat := GL_UNSIGNED_SHORT;
  2825. {$ELSE}
  2826. fOpenGLFormat := tfRGBA8ub4;
  2827. {$IFEND}
  2828. end;
  2829. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2830. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2831. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2832. procedure TfdBGRX4us1.SetValues;
  2833. begin
  2834. inherited SetValues;
  2835. fBitsPerPixel := 16;
  2836. fFormat := tfBGRX4us1;
  2837. fWithAlpha := tfBGRA4us1;
  2838. fWithoutAlpha := tfBGRX4us1;
  2839. fRGBInverted := tfRGBX4us1;
  2840. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2841. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  2842. {$IFNDEF OPENGL_ES}
  2843. fOpenGLFormat := tfBGRX4us1;
  2844. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2845. fglInternalFormat := GL_RGB4;
  2846. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2847. {$ELSE}
  2848. fOpenGLFormat := tfR5G6B5us1;
  2849. {$ENDIF}
  2850. end;
  2851. procedure TfdXBGR4us1.SetValues;
  2852. begin
  2853. inherited SetValues;
  2854. fBitsPerPixel := 16;
  2855. fFormat := tfXBGR4us1;
  2856. fWithAlpha := tfABGR4us1;
  2857. fWithoutAlpha := tfXBGR4us1;
  2858. fRGBInverted := tfXRGB4us1;
  2859. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2860. fShift := glBitmapRec4ub( 0, 4, 8, 0);
  2861. {$IFNDEF OPENGL_ES}
  2862. fOpenGLFormat := tfXBGR4us1;
  2863. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2864. fglInternalFormat := GL_RGB4;
  2865. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2866. {$ELSE}
  2867. fOpenGLFormat := tfR5G6B5us1;
  2868. {$ENDIF}
  2869. end;
  2870. procedure TfdB5G6R5us1.SetValues;
  2871. begin
  2872. inherited SetValues;
  2873. fBitsPerPixel := 16;
  2874. fFormat := tfB5G6R5us1;
  2875. fWithAlpha := tfBGR5A1us1;
  2876. fWithoutAlpha := tfB5G6R5us1;
  2877. fRGBInverted := tfR5G6B5us1;
  2878. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2879. fShift := glBitmapRec4ub( 0, 5, 11, 0);
  2880. {$IFNDEF OPENGL_ES}
  2881. fOpenGLFormat := tfB5G6R5us1;
  2882. fglFormat := GL_RGB;
  2883. fglInternalFormat := GL_RGB565;
  2884. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2885. {$ELSE}
  2886. fOpenGLFormat := tfR5G6B5us1;
  2887. {$ENDIF}
  2888. end;
  2889. procedure TfdBGR5X1us1.SetValues;
  2890. begin
  2891. inherited SetValues;
  2892. fBitsPerPixel := 16;
  2893. fFormat := tfBGR5X1us1;
  2894. fWithAlpha := tfBGR5A1us1;
  2895. fWithoutAlpha := tfBGR5X1us1;
  2896. fRGBInverted := tfRGB5X1us1;
  2897. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2898. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  2899. {$IFNDEF OPENGL_ES}
  2900. fOpenGLFormat := tfBGR5X1us1;
  2901. fglFormat := GL_BGRA;
  2902. fglInternalFormat := GL_RGB5;
  2903. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2904. {$ELSE}
  2905. fOpenGLFormat := tfR5G6B5us1;
  2906. {$ENDIF}
  2907. end;
  2908. procedure TfdX1BGR5us1.SetValues;
  2909. begin
  2910. inherited SetValues;
  2911. fBitsPerPixel := 16;
  2912. fFormat := tfX1BGR5us1;
  2913. fWithAlpha := tfA1BGR5us1;
  2914. fWithoutAlpha := tfX1BGR5us1;
  2915. fRGBInverted := tfX1RGB5us1;
  2916. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2917. fShift := glBitmapRec4ub( 0, 5, 10, 0);
  2918. {$IFNDEF OPENGL_ES}
  2919. fOpenGLFormat := tfX1BGR5us1;
  2920. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2921. fglInternalFormat := GL_RGB5;
  2922. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2923. {$ELSE}
  2924. fOpenGLFormat := tfR5G6B5us1;
  2925. {$ENDIF}
  2926. end;
  2927. procedure TfdBGR8ub3.SetValues;
  2928. begin
  2929. inherited SetValues;
  2930. fBitsPerPixel := 24;
  2931. fFormat := tfBGR8ub3;
  2932. fWithAlpha := tfBGRA8ub4;
  2933. fWithoutAlpha := tfBGR8ub3;
  2934. fRGBInverted := tfRGB8ub3;
  2935. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2936. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2937. {$IFNDEF OPENGL_ES}
  2938. fOpenGLFormat := tfBGR8ub3;
  2939. fglFormat := GL_BGR;
  2940. fglInternalFormat := GL_RGB8;
  2941. fglDataFormat := GL_UNSIGNED_BYTE;
  2942. {$ELSE}
  2943. fOpenGLFormat := tfRGB8ub3;
  2944. {$ENDIF}
  2945. end;
  2946. procedure TfdBGRX8ui1.SetValues;
  2947. begin
  2948. inherited SetValues;
  2949. fBitsPerPixel := 32;
  2950. fFormat := tfBGRX8ui1;
  2951. fWithAlpha := tfBGRA8ui1;
  2952. fWithoutAlpha := tfBGRX8ui1;
  2953. fRGBInverted := tfRGBX8ui1;
  2954. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2955. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  2956. {$IFNDEF OPENGL_ES}
  2957. fOpenGLFormat := tfBGRX8ui1;
  2958. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2959. fglInternalFormat := GL_RGB8;
  2960. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2961. {$ELSE}
  2962. fOpenGLFormat := tfRGB8ub3;
  2963. {$ENDIF}
  2964. end;
  2965. procedure TfdXBGR8ui1.SetValues;
  2966. begin
  2967. inherited SetValues;
  2968. fBitsPerPixel := 32;
  2969. fFormat := tfXBGR8ui1;
  2970. fWithAlpha := tfABGR8ui1;
  2971. fWithoutAlpha := tfXBGR8ui1;
  2972. fRGBInverted := tfXRGB8ui1;
  2973. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2974. fShift := glBitmapRec4ub( 0, 8, 16, 0);
  2975. {$IFNDEF OPENGL_ES}
  2976. fOpenGLFormat := tfXBGR8ui1;
  2977. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2978. fglInternalFormat := GL_RGB8;
  2979. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2980. {$ELSE}
  2981. fOpenGLFormat := tfRGB8ub3;
  2982. {$ENDIF}
  2983. end;
  2984. procedure TfdBGR10X2ui1.SetValues;
  2985. begin
  2986. inherited SetValues;
  2987. fBitsPerPixel := 32;
  2988. fFormat := tfBGR10X2ui1;
  2989. fWithAlpha := tfBGR10A2ui1;
  2990. fWithoutAlpha := tfBGR10X2ui1;
  2991. fRGBInverted := tfRGB10X2ui1;
  2992. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2993. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  2994. {$IFNDEF OPENGL_ES}
  2995. fOpenGLFormat := tfBGR10X2ui1;
  2996. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2997. fglInternalFormat := GL_RGB10;
  2998. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2999. {$ELSE}
  3000. fOpenGLFormat := tfRGB16us3;
  3001. {$ENDIF}
  3002. end;
  3003. procedure TfdX2BGR10ui1.SetValues;
  3004. begin
  3005. inherited SetValues;
  3006. fBitsPerPixel := 32;
  3007. fFormat := tfX2BGR10ui1;
  3008. fWithAlpha := tfA2BGR10ui1;
  3009. fWithoutAlpha := tfX2BGR10ui1;
  3010. fRGBInverted := tfX2RGB10ui1;
  3011. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  3012. fShift := glBitmapRec4ub( 0, 10, 20, 0);
  3013. {$IFNDEF OPENGL_ES}
  3014. fOpenGLFormat := tfX2BGR10ui1;
  3015. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3016. fglInternalFormat := GL_RGB10;
  3017. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3018. {$ELSE}
  3019. fOpenGLFormat := tfRGB16us3;
  3020. {$ENDIF}
  3021. end;
  3022. procedure TfdBGR16us3.SetValues;
  3023. begin
  3024. inherited SetValues;
  3025. fBitsPerPixel := 48;
  3026. fFormat := tfBGR16us3;
  3027. fWithAlpha := tfBGRA16us4;
  3028. fWithoutAlpha := tfBGR16us3;
  3029. fRGBInverted := tfRGB16us3;
  3030. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  3031. fShift := glBitmapRec4ub(32, 16, 0, 0);
  3032. {$IFNDEF OPENGL_ES}
  3033. fOpenGLFormat := tfBGR16us3;
  3034. fglFormat := GL_BGR;
  3035. fglInternalFormat := GL_RGB16;
  3036. fglDataFormat := GL_UNSIGNED_SHORT;
  3037. {$ELSE}
  3038. fOpenGLFormat := tfRGB16us3;
  3039. {$ENDIF}
  3040. end;
  3041. procedure TfdBGRA4us1.SetValues;
  3042. begin
  3043. inherited SetValues;
  3044. fBitsPerPixel := 16;
  3045. fFormat := tfBGRA4us1;
  3046. fWithAlpha := tfBGRA4us1;
  3047. fWithoutAlpha := tfBGRX4us1;
  3048. fRGBInverted := tfRGBA4us1;
  3049. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3050. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  3051. {$IFNDEF OPENGL_ES}
  3052. fOpenGLFormat := tfBGRA4us1;
  3053. fglFormat := GL_BGRA;
  3054. fglInternalFormat := GL_RGBA4;
  3055. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3056. {$ELSE}
  3057. fOpenGLFormat := tfRGBA4us1;
  3058. {$ENDIF}
  3059. end;
  3060. procedure TfdABGR4us1.SetValues;
  3061. begin
  3062. inherited SetValues;
  3063. fBitsPerPixel := 16;
  3064. fFormat := tfABGR4us1;
  3065. fWithAlpha := tfABGR4us1;
  3066. fWithoutAlpha := tfXBGR4us1;
  3067. fRGBInverted := tfARGB4us1;
  3068. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3069. fShift := glBitmapRec4ub( 0, 4, 8, 12);
  3070. {$IFNDEF OPENGL_ES}
  3071. fOpenGLFormat := tfABGR4us1;
  3072. fglFormat := GL_RGBA;
  3073. fglInternalFormat := GL_RGBA4;
  3074. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3075. {$ELSE}
  3076. fOpenGLFormat := tfRGBA4us1;
  3077. {$ENDIF}
  3078. end;
  3079. procedure TfdBGR5A1us1.SetValues;
  3080. begin
  3081. inherited SetValues;
  3082. fBitsPerPixel := 16;
  3083. fFormat := tfBGR5A1us1;
  3084. fWithAlpha := tfBGR5A1us1;
  3085. fWithoutAlpha := tfBGR5X1us1;
  3086. fRGBInverted := tfRGB5A1us1;
  3087. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3088. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  3089. {$IFNDEF OPENGL_ES}
  3090. fOpenGLFormat := tfBGR5A1us1;
  3091. fglFormat := GL_BGRA;
  3092. fglInternalFormat := GL_RGB5_A1;
  3093. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3094. {$ELSE}
  3095. fOpenGLFormat := tfRGB5A1us1;
  3096. {$ENDIF}
  3097. end;
  3098. procedure TfdA1BGR5us1.SetValues;
  3099. begin
  3100. inherited SetValues;
  3101. fBitsPerPixel := 16;
  3102. fFormat := tfA1BGR5us1;
  3103. fWithAlpha := tfA1BGR5us1;
  3104. fWithoutAlpha := tfX1BGR5us1;
  3105. fRGBInverted := tfA1RGB5us1;
  3106. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3107. fShift := glBitmapRec4ub( 0, 5, 10, 15);
  3108. {$IFNDEF OPENGL_ES}
  3109. fOpenGLFormat := tfA1BGR5us1;
  3110. fglFormat := GL_RGBA;
  3111. fglInternalFormat := GL_RGB5_A1;
  3112. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3113. {$ELSE}
  3114. fOpenGLFormat := tfRGB5A1us1;
  3115. {$ENDIF}
  3116. end;
  3117. procedure TfdBGRA8ui1.SetValues;
  3118. begin
  3119. inherited SetValues;
  3120. fBitsPerPixel := 32;
  3121. fFormat := tfBGRA8ui1;
  3122. fWithAlpha := tfBGRA8ui1;
  3123. fWithoutAlpha := tfBGRX8ui1;
  3124. fRGBInverted := tfRGBA8ui1;
  3125. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3126. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  3127. {$IFNDEF OPENGL_ES}
  3128. fOpenGLFormat := tfBGRA8ui1;
  3129. fglFormat := GL_BGRA;
  3130. fglInternalFormat := GL_RGBA8;
  3131. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3132. {$ELSE}
  3133. fOpenGLFormat := tfRGBA8ub4;
  3134. {$ENDIF}
  3135. end;
  3136. procedure TfdABGR8ui1.SetValues;
  3137. begin
  3138. inherited SetValues;
  3139. fBitsPerPixel := 32;
  3140. fFormat := tfABGR8ui1;
  3141. fWithAlpha := tfABGR8ui1;
  3142. fWithoutAlpha := tfXBGR8ui1;
  3143. fRGBInverted := tfARGB8ui1;
  3144. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3145. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  3146. {$IFNDEF OPENGL_ES}
  3147. fOpenGLFormat := tfABGR8ui1;
  3148. fglFormat := GL_RGBA;
  3149. fglInternalFormat := GL_RGBA8;
  3150. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3151. {$ELSE}
  3152. fOpenGLFormat := tfRGBA8ub4
  3153. {$ENDIF}
  3154. end;
  3155. procedure TfdBGRA8ub4.SetValues;
  3156. begin
  3157. inherited SetValues;
  3158. fBitsPerPixel := 32;
  3159. fFormat := tfBGRA8ub4;
  3160. fWithAlpha := tfBGRA8ub4;
  3161. fWithoutAlpha := tfBGR8ub3;
  3162. fRGBInverted := tfRGBA8ub4;
  3163. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3164. fShift := glBitmapRec4ub(16, 8, 0, 24);
  3165. {$IFNDEF OPENGL_ES}
  3166. fOpenGLFormat := tfBGRA8ub4;
  3167. fglFormat := GL_BGRA;
  3168. fglInternalFormat := GL_RGBA8;
  3169. fglDataFormat := GL_UNSIGNED_BYTE;
  3170. {$ELSE}
  3171. fOpenGLFormat := tfRGBA8ub4;
  3172. {$ENDIF}
  3173. end;
  3174. procedure TfdBGR10A2ui1.SetValues;
  3175. begin
  3176. inherited SetValues;
  3177. fBitsPerPixel := 32;
  3178. fFormat := tfBGR10A2ui1;
  3179. fWithAlpha := tfBGR10A2ui1;
  3180. fWithoutAlpha := tfBGR10X2ui1;
  3181. fRGBInverted := tfRGB10A2ui1;
  3182. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3183. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  3184. {$IFNDEF OPENGL_ES}
  3185. fOpenGLFormat := tfBGR10A2ui1;
  3186. fglFormat := GL_BGRA;
  3187. fglInternalFormat := GL_RGB10_A2;
  3188. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3189. {$ELSE}
  3190. fOpenGLFormat := tfA2RGB10ui1;
  3191. {$ENDIF}
  3192. end;
  3193. procedure TfdA2BGR10ui1.SetValues;
  3194. begin
  3195. inherited SetValues;
  3196. fBitsPerPixel := 32;
  3197. fFormat := tfA2BGR10ui1;
  3198. fWithAlpha := tfA2BGR10ui1;
  3199. fWithoutAlpha := tfX2BGR10ui1;
  3200. fRGBInverted := tfA2RGB10ui1;
  3201. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3202. fShift := glBitmapRec4ub( 0, 10, 20, 30);
  3203. {$IFNDEF OPENGL_ES}
  3204. fOpenGLFormat := tfA2BGR10ui1;
  3205. fglFormat := GL_RGBA;
  3206. fglInternalFormat := GL_RGB10_A2;
  3207. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3208. {$ELSE}
  3209. fOpenGLFormat := tfA2RGB10ui1;
  3210. {$ENDIF}
  3211. end;
  3212. procedure TfdBGRA16us4.SetValues;
  3213. begin
  3214. inherited SetValues;
  3215. fBitsPerPixel := 64;
  3216. fFormat := tfBGRA16us4;
  3217. fWithAlpha := tfBGRA16us4;
  3218. fWithoutAlpha := tfBGR16us3;
  3219. fRGBInverted := tfRGBA16us4;
  3220. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3221. fShift := glBitmapRec4ub(32, 16, 0, 48);
  3222. {$IFNDEF OPENGL_ES}
  3223. fOpenGLFormat := tfBGRA16us4;
  3224. fglFormat := GL_BGRA;
  3225. fglInternalFormat := GL_RGBA16;
  3226. fglDataFormat := GL_UNSIGNED_SHORT;
  3227. {$ELSE}
  3228. fOpenGLFormat := tfRGBA16us4;
  3229. {$ENDIF}
  3230. end;
  3231. procedure TfdDepth16us1.SetValues;
  3232. begin
  3233. inherited SetValues;
  3234. fBitsPerPixel := 16;
  3235. fFormat := tfDepth16us1;
  3236. fWithoutAlpha := tfDepth16us1;
  3237. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3238. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3239. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  3240. fOpenGLFormat := tfDepth16us1;
  3241. fglFormat := GL_DEPTH_COMPONENT;
  3242. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3243. fglDataFormat := GL_UNSIGNED_SHORT;
  3244. {$IFEND}
  3245. end;
  3246. procedure TfdDepth24ui1.SetValues;
  3247. begin
  3248. inherited SetValues;
  3249. fBitsPerPixel := 32;
  3250. fFormat := tfDepth24ui1;
  3251. fWithoutAlpha := tfDepth24ui1;
  3252. fOpenGLFormat := tfDepth24ui1;
  3253. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3254. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3255. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  3256. fOpenGLFormat := tfDepth24ui1;
  3257. fglFormat := GL_DEPTH_COMPONENT;
  3258. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3259. fglDataFormat := GL_UNSIGNED_INT;
  3260. {$IFEND}
  3261. end;
  3262. procedure TfdDepth32ui1.SetValues;
  3263. begin
  3264. inherited SetValues;
  3265. fBitsPerPixel := 32;
  3266. fFormat := tfDepth32ui1;
  3267. fWithoutAlpha := tfDepth32ui1;
  3268. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3269. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3270. {$IF NOT DEFINED(OPENGL_ES)}
  3271. fOpenGLFormat := tfDepth32ui1;
  3272. fglFormat := GL_DEPTH_COMPONENT;
  3273. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3274. fglDataFormat := GL_UNSIGNED_INT;
  3275. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  3276. fOpenGLFormat := tfDepth24ui1;
  3277. {$ELSEIF DEFINED(OPENGL_ES_2_0)}
  3278. fOpenGLFormat := tfDepth16us1;
  3279. {$IFEND}
  3280. end;
  3281. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3282. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3283. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3284. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3285. begin
  3286. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3287. end;
  3288. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3289. begin
  3290. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3291. end;
  3292. procedure TfdS3tcDtx1RGBA.SetValues;
  3293. begin
  3294. inherited SetValues;
  3295. fFormat := tfS3tcDtx1RGBA;
  3296. fWithAlpha := tfS3tcDtx1RGBA;
  3297. fUncompressed := tfRGB5A1us1;
  3298. fBitsPerPixel := 4;
  3299. fIsCompressed := true;
  3300. {$IFNDEF OPENGL_ES}
  3301. fOpenGLFormat := tfS3tcDtx1RGBA;
  3302. fglFormat := GL_COMPRESSED_RGBA;
  3303. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3304. fglDataFormat := GL_UNSIGNED_BYTE;
  3305. {$ELSE}
  3306. fOpenGLFormat := fUncompressed;
  3307. {$ENDIF}
  3308. end;
  3309. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3310. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3311. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3312. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3313. begin
  3314. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3315. end;
  3316. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3317. begin
  3318. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3319. end;
  3320. procedure TfdS3tcDtx3RGBA.SetValues;
  3321. begin
  3322. inherited SetValues;
  3323. fFormat := tfS3tcDtx3RGBA;
  3324. fWithAlpha := tfS3tcDtx3RGBA;
  3325. fUncompressed := tfRGBA8ub4;
  3326. fBitsPerPixel := 8;
  3327. fIsCompressed := true;
  3328. {$IFNDEF OPENGL_ES}
  3329. fOpenGLFormat := tfS3tcDtx3RGBA;
  3330. fglFormat := GL_COMPRESSED_RGBA;
  3331. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3332. fglDataFormat := GL_UNSIGNED_BYTE;
  3333. {$ELSE}
  3334. fOpenGLFormat := fUncompressed;
  3335. {$ENDIF}
  3336. end;
  3337. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3338. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3339. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3340. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3341. begin
  3342. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3343. end;
  3344. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3345. begin
  3346. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3347. end;
  3348. procedure TfdS3tcDtx5RGBA.SetValues;
  3349. begin
  3350. inherited SetValues;
  3351. fFormat := tfS3tcDtx3RGBA;
  3352. fWithAlpha := tfS3tcDtx3RGBA;
  3353. fUncompressed := tfRGBA8ub4;
  3354. fBitsPerPixel := 8;
  3355. fIsCompressed := true;
  3356. {$IFNDEF OPENGL_ES}
  3357. fOpenGLFormat := tfS3tcDtx3RGBA;
  3358. fglFormat := GL_COMPRESSED_RGBA;
  3359. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3360. fglDataFormat := GL_UNSIGNED_BYTE;
  3361. {$ELSE}
  3362. fOpenGLFormat := fUncompressed;
  3363. {$ENDIF}
  3364. end;
  3365. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3366. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3367. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3368. function TglBitmapFormatDescriptor.GetHasRed: Boolean;
  3369. begin
  3370. result := (fPrecision.r > 0);
  3371. end;
  3372. function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
  3373. begin
  3374. result := (fPrecision.g > 0);
  3375. end;
  3376. function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
  3377. begin
  3378. result := (fPrecision.b > 0);
  3379. end;
  3380. function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
  3381. begin
  3382. result := (fPrecision.a > 0);
  3383. end;
  3384. function TglBitmapFormatDescriptor.GetHasColor: Boolean;
  3385. begin
  3386. result := HasRed or HasGreen or HasBlue;
  3387. end;
  3388. function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
  3389. begin
  3390. result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
  3391. end;
  3392. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3393. procedure TglBitmapFormatDescriptor.SetValues;
  3394. begin
  3395. fFormat := tfEmpty;
  3396. fWithAlpha := tfEmpty;
  3397. fWithoutAlpha := tfEmpty;
  3398. fOpenGLFormat := tfEmpty;
  3399. fRGBInverted := tfEmpty;
  3400. fUncompressed := tfEmpty;
  3401. fBitsPerPixel := 0;
  3402. fIsCompressed := false;
  3403. fglFormat := 0;
  3404. fglInternalFormat := 0;
  3405. fglDataFormat := 0;
  3406. FillChar(fPrecision, 0, SizeOf(fPrecision));
  3407. FillChar(fShift, 0, SizeOf(fShift));
  3408. end;
  3409. procedure TglBitmapFormatDescriptor.CalcValues;
  3410. var
  3411. i: Integer;
  3412. begin
  3413. fBytesPerPixel := fBitsPerPixel / 8;
  3414. fChannelCount := 0;
  3415. for i := 0 to 3 do begin
  3416. if (fPrecision.arr[i] > 0) then
  3417. inc(fChannelCount);
  3418. fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
  3419. fMask.arr[i] := fRange.arr[i] shl fShift.arr[i];
  3420. end;
  3421. end;
  3422. constructor TglBitmapFormatDescriptor.Create;
  3423. begin
  3424. inherited Create;
  3425. SetValues;
  3426. CalcValues;
  3427. end;
  3428. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3429. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3430. var
  3431. f: TglBitmapFormat;
  3432. begin
  3433. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3434. result := TFormatDescriptor.Get(f);
  3435. if (result.glInternalFormat = aInternalFormat) then
  3436. exit;
  3437. end;
  3438. result := TFormatDescriptor.Get(tfEmpty);
  3439. end;
  3440. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3441. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3442. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3443. class procedure TFormatDescriptor.Init;
  3444. begin
  3445. if not Assigned(FormatDescriptorCS) then
  3446. FormatDescriptorCS := TCriticalSection.Create;
  3447. end;
  3448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3449. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3450. begin
  3451. FormatDescriptorCS.Enter;
  3452. try
  3453. result := FormatDescriptors[aFormat];
  3454. if not Assigned(result) then begin
  3455. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3456. FormatDescriptors[aFormat] := result;
  3457. end;
  3458. finally
  3459. FormatDescriptorCS.Leave;
  3460. end;
  3461. end;
  3462. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3463. class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3464. begin
  3465. result := Get(Get(aFormat).WithAlpha);
  3466. end;
  3467. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3468. class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
  3469. var
  3470. ft: TglBitmapFormat;
  3471. begin
  3472. // find matching format with OpenGL support
  3473. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3474. result := Get(ft);
  3475. if (result.MaskMatch(aMask)) and
  3476. (result.glFormat <> 0) and
  3477. (result.glInternalFormat <> 0) and
  3478. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3479. then
  3480. exit;
  3481. end;
  3482. // find matching format without OpenGL Support
  3483. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3484. result := Get(ft);
  3485. if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3486. exit;
  3487. end;
  3488. result := TFormatDescriptor.Get(tfEmpty);
  3489. end;
  3490. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3491. class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  3492. var
  3493. ft: TglBitmapFormat;
  3494. begin
  3495. // find matching format with OpenGL support
  3496. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3497. result := Get(ft);
  3498. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3499. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3500. (result.glFormat <> 0) and
  3501. (result.glInternalFormat <> 0) and
  3502. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3503. then
  3504. exit;
  3505. end;
  3506. // find matching format without OpenGL Support
  3507. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3508. result := Get(ft);
  3509. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3510. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3511. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3512. exit;
  3513. end;
  3514. result := TFormatDescriptor.Get(tfEmpty);
  3515. end;
  3516. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3517. class procedure TFormatDescriptor.Clear;
  3518. var
  3519. f: TglBitmapFormat;
  3520. begin
  3521. FormatDescriptorCS.Enter;
  3522. try
  3523. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3524. FreeAndNil(FormatDescriptors[f]);
  3525. finally
  3526. FormatDescriptorCS.Leave;
  3527. end;
  3528. end;
  3529. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3530. class procedure TFormatDescriptor.Finalize;
  3531. begin
  3532. Clear;
  3533. FreeAndNil(FormatDescriptorCS);
  3534. end;
  3535. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3536. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3537. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3538. procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
  3539. var
  3540. i: Integer;
  3541. begin
  3542. for i := 0 to 3 do begin
  3543. fShift.arr[i] := 0;
  3544. while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin
  3545. aMask.arr[i] := aMask.arr[i] shr 1;
  3546. inc(fShift.arr[i]);
  3547. end;
  3548. fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
  3549. end;
  3550. CalcValues;
  3551. end;
  3552. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3553. procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3554. begin
  3555. fBitsPerPixel := aBBP;
  3556. fPrecision := aPrec;
  3557. fShift := aShift;
  3558. CalcValues;
  3559. end;
  3560. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3561. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3562. var
  3563. data: QWord;
  3564. begin
  3565. data :=
  3566. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3567. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3568. ((aPixel.Data.b and Range.b) shl Shift.b) or
  3569. ((aPixel.Data.a and Range.a) shl Shift.a);
  3570. case BitsPerPixel of
  3571. 8: aData^ := data;
  3572. 16: PWord(aData)^ := data;
  3573. 32: PCardinal(aData)^ := data;
  3574. 64: PQWord(aData)^ := data;
  3575. else
  3576. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3577. end;
  3578. inc(aData, Round(BytesPerPixel));
  3579. end;
  3580. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3581. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3582. var
  3583. data: QWord;
  3584. i: Integer;
  3585. begin
  3586. case BitsPerPixel of
  3587. 8: data := aData^;
  3588. 16: data := PWord(aData)^;
  3589. 32: data := PCardinal(aData)^;
  3590. 64: data := PQWord(aData)^;
  3591. else
  3592. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3593. end;
  3594. for i := 0 to 3 do
  3595. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
  3596. inc(aData, Round(BytesPerPixel));
  3597. end;
  3598. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3599. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3600. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3601. procedure TbmpColorTableFormat.SetValues;
  3602. begin
  3603. inherited SetValues;
  3604. fShift := glBitmapRec4ub(8, 8, 8, 0);
  3605. end;
  3606. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3607. procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3608. begin
  3609. fFormat := aFormat;
  3610. fBitsPerPixel := aBPP;
  3611. fPrecision := aPrec;
  3612. fShift := aShift;
  3613. CalcValues;
  3614. end;
  3615. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3616. procedure TbmpColorTableFormat.CalcValues;
  3617. begin
  3618. inherited CalcValues;
  3619. end;
  3620. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3621. procedure TbmpColorTableFormat.CreateColorTable;
  3622. var
  3623. i: Integer;
  3624. begin
  3625. SetLength(fColorTable, 256);
  3626. if not HasColor then begin
  3627. // alpha
  3628. for i := 0 to High(fColorTable) do begin
  3629. fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3630. fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3631. fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3632. fColorTable[i].a := 0;
  3633. end;
  3634. end else begin
  3635. // normal
  3636. for i := 0 to High(fColorTable) do begin
  3637. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3638. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3639. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3640. fColorTable[i].a := 0;
  3641. end;
  3642. end;
  3643. end;
  3644. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3645. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3646. begin
  3647. if (BitsPerPixel <> 8) then
  3648. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3649. if not HasColor then
  3650. // alpha
  3651. aData^ := aPixel.Data.a
  3652. else
  3653. // normal
  3654. aData^ := Round(
  3655. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3656. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3657. ((aPixel.Data.b and Range.b) shl Shift.b));
  3658. inc(aData);
  3659. end;
  3660. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3661. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3662. begin
  3663. if (BitsPerPixel <> 8) then
  3664. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3665. with fColorTable[aData^] do begin
  3666. aPixel.Data.r := r;
  3667. aPixel.Data.g := g;
  3668. aPixel.Data.b := b;
  3669. aPixel.Data.a := a;
  3670. end;
  3671. inc(aData, 1);
  3672. end;
  3673. destructor TbmpColorTableFormat.Destroy;
  3674. begin
  3675. SetLength(fColorTable, 0);
  3676. inherited Destroy;
  3677. end;
  3678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3679. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3680. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3681. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3682. var
  3683. i: Integer;
  3684. begin
  3685. for i := 0 to 3 do begin
  3686. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3687. if (aSourceFD.Range.arr[i] > 0) then
  3688. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3689. else
  3690. aPixel.Data.arr[i] := 0;
  3691. end;
  3692. end;
  3693. end;
  3694. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3695. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3696. begin
  3697. with aFuncRec do begin
  3698. if (Source.Range.r > 0) then
  3699. Dest.Data.r := Source.Data.r;
  3700. if (Source.Range.g > 0) then
  3701. Dest.Data.g := Source.Data.g;
  3702. if (Source.Range.b > 0) then
  3703. Dest.Data.b := Source.Data.b;
  3704. if (Source.Range.a > 0) then
  3705. Dest.Data.a := Source.Data.a;
  3706. end;
  3707. end;
  3708. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3709. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3710. var
  3711. i: Integer;
  3712. begin
  3713. with aFuncRec do begin
  3714. for i := 0 to 3 do
  3715. if (Source.Range.arr[i] > 0) then
  3716. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3717. end;
  3718. end;
  3719. type
  3720. TShiftData = packed record
  3721. case Integer of
  3722. 0: (r, g, b, a: SmallInt);
  3723. 1: (arr: array[0..3] of SmallInt);
  3724. end;
  3725. PShiftData = ^TShiftData;
  3726. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3727. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3728. var
  3729. i: Integer;
  3730. begin
  3731. with aFuncRec do
  3732. for i := 0 to 3 do
  3733. if (Source.Range.arr[i] > 0) then
  3734. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3735. end;
  3736. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3737. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3738. begin
  3739. with aFuncRec do begin
  3740. Dest.Data := Source.Data;
  3741. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3742. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3743. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3744. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3745. end;
  3746. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3747. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3748. end;
  3749. end;
  3750. end;
  3751. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3752. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3753. var
  3754. i: Integer;
  3755. begin
  3756. with aFuncRec do begin
  3757. for i := 0 to 3 do
  3758. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3759. end;
  3760. end;
  3761. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3762. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3763. var
  3764. Temp: Single;
  3765. begin
  3766. with FuncRec do begin
  3767. if (FuncRec.Args = nil) then begin //source has no alpha
  3768. Temp :=
  3769. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3770. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3771. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3772. Dest.Data.a := Round(Dest.Range.a * Temp);
  3773. end else
  3774. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3775. end;
  3776. end;
  3777. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3778. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3779. type
  3780. PglBitmapPixelData = ^TglBitmapPixelData;
  3781. begin
  3782. with FuncRec do begin
  3783. Dest.Data.r := Source.Data.r;
  3784. Dest.Data.g := Source.Data.g;
  3785. Dest.Data.b := Source.Data.b;
  3786. with PglBitmapPixelData(Args)^ do
  3787. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3788. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3789. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3790. Dest.Data.a := 0
  3791. else
  3792. Dest.Data.a := Dest.Range.a;
  3793. end;
  3794. end;
  3795. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3796. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3797. begin
  3798. with FuncRec do begin
  3799. Dest.Data.r := Source.Data.r;
  3800. Dest.Data.g := Source.Data.g;
  3801. Dest.Data.b := Source.Data.b;
  3802. Dest.Data.a := PCardinal(Args)^;
  3803. end;
  3804. end;
  3805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3806. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3807. type
  3808. PRGBPix = ^TRGBPix;
  3809. TRGBPix = array [0..2] of byte;
  3810. var
  3811. Temp: Byte;
  3812. begin
  3813. while aWidth > 0 do begin
  3814. Temp := PRGBPix(aData)^[0];
  3815. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3816. PRGBPix(aData)^[2] := Temp;
  3817. if aHasAlpha then
  3818. Inc(aData, 4)
  3819. else
  3820. Inc(aData, 3);
  3821. dec(aWidth);
  3822. end;
  3823. end;
  3824. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3825. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3826. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3827. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  3828. begin
  3829. result := TFormatDescriptor.Get(Format);
  3830. end;
  3831. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3832. function TglBitmap.GetWidth: Integer;
  3833. begin
  3834. if (ffX in fDimension.Fields) then
  3835. result := fDimension.X
  3836. else
  3837. result := -1;
  3838. end;
  3839. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3840. function TglBitmap.GetHeight: Integer;
  3841. begin
  3842. if (ffY in fDimension.Fields) then
  3843. result := fDimension.Y
  3844. else
  3845. result := -1;
  3846. end;
  3847. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3848. function TglBitmap.GetFileWidth: Integer;
  3849. begin
  3850. result := Max(1, Width);
  3851. end;
  3852. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3853. function TglBitmap.GetFileHeight: Integer;
  3854. begin
  3855. result := Max(1, Height);
  3856. end;
  3857. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3858. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3859. begin
  3860. if fCustomData = aValue then
  3861. exit;
  3862. fCustomData := aValue;
  3863. end;
  3864. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3865. procedure TglBitmap.SetCustomName(const aValue: String);
  3866. begin
  3867. if fCustomName = aValue then
  3868. exit;
  3869. fCustomName := aValue;
  3870. end;
  3871. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3872. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3873. begin
  3874. if fCustomNameW = aValue then
  3875. exit;
  3876. fCustomNameW := aValue;
  3877. end;
  3878. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3879. procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
  3880. begin
  3881. if fFreeDataOnDestroy = aValue then
  3882. exit;
  3883. fFreeDataOnDestroy := aValue;
  3884. end;
  3885. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3886. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3887. begin
  3888. if fDeleteTextureOnFree = aValue then
  3889. exit;
  3890. fDeleteTextureOnFree := aValue;
  3891. end;
  3892. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3893. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3894. begin
  3895. if fFormat = aValue then
  3896. exit;
  3897. if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
  3898. raise EglBitmapUnsupportedFormat.Create(Format);
  3899. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  3900. end;
  3901. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3902. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3903. begin
  3904. if fFreeDataAfterGenTexture = aValue then
  3905. exit;
  3906. fFreeDataAfterGenTexture := aValue;
  3907. end;
  3908. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3909. procedure TglBitmap.SetID(const aValue: Cardinal);
  3910. begin
  3911. if fID = aValue then
  3912. exit;
  3913. fID := aValue;
  3914. end;
  3915. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3916. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3917. begin
  3918. if fMipMap = aValue then
  3919. exit;
  3920. fMipMap := aValue;
  3921. end;
  3922. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3923. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3924. begin
  3925. if fTarget = aValue then
  3926. exit;
  3927. fTarget := aValue;
  3928. end;
  3929. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3930. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3931. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  3932. var
  3933. MaxAnisotropic: Integer;
  3934. {$IFEND}
  3935. begin
  3936. fAnisotropic := aValue;
  3937. if (ID > 0) then begin
  3938. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  3939. if GL_EXT_texture_filter_anisotropic then begin
  3940. if fAnisotropic > 0 then begin
  3941. Bind(false);
  3942. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3943. if aValue > MaxAnisotropic then
  3944. fAnisotropic := MaxAnisotropic;
  3945. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3946. end;
  3947. end else begin
  3948. fAnisotropic := 0;
  3949. end;
  3950. {$ELSE}
  3951. fAnisotropic := 0;
  3952. {$IFEND}
  3953. end;
  3954. end;
  3955. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3956. procedure TglBitmap.CreateID;
  3957. begin
  3958. if (ID <> 0) then
  3959. glDeleteTextures(1, @fID);
  3960. glGenTextures(1, @fID);
  3961. Bind(false);
  3962. end;
  3963. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3964. procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  3965. begin
  3966. // Set Up Parameters
  3967. SetWrap(fWrapS, fWrapT, fWrapR);
  3968. SetFilter(fFilterMin, fFilterMag);
  3969. SetAnisotropic(fAnisotropic);
  3970. {$IFNDEF OPENGL_ES}
  3971. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3972. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  3973. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3974. {$ENDIF}
  3975. {$IFNDEF OPENGL_ES}
  3976. // Mip Maps Generation Mode
  3977. aBuildWithGlu := false;
  3978. if (MipMap = mmMipmap) then begin
  3979. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3980. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3981. else
  3982. aBuildWithGlu := true;
  3983. end else if (MipMap = mmMipmapGlu) then
  3984. aBuildWithGlu := true;
  3985. {$ELSE}
  3986. if (MipMap = mmMipmap) then
  3987. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
  3988. {$ENDIF}
  3989. end;
  3990. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3991. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  3992. const aWidth: Integer; const aHeight: Integer);
  3993. var
  3994. s: Single;
  3995. begin
  3996. if (Data <> aData) then begin
  3997. if (Assigned(Data)) then
  3998. FreeMem(Data);
  3999. fData := aData;
  4000. end;
  4001. if not Assigned(fData) then begin
  4002. fPixelSize := 0;
  4003. fRowSize := 0;
  4004. end else begin
  4005. FillChar(fDimension, SizeOf(fDimension), 0);
  4006. if aWidth <> -1 then begin
  4007. fDimension.Fields := fDimension.Fields + [ffX];
  4008. fDimension.X := aWidth;
  4009. end;
  4010. if aHeight <> -1 then begin
  4011. fDimension.Fields := fDimension.Fields + [ffY];
  4012. fDimension.Y := aHeight;
  4013. end;
  4014. s := TFormatDescriptor.Get(aFormat).BytesPerPixel;
  4015. fFormat := aFormat;
  4016. fPixelSize := Ceil(s);
  4017. fRowSize := Ceil(s * aWidth);
  4018. end;
  4019. end;
  4020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4021. function TglBitmap.FlipHorz: Boolean;
  4022. begin
  4023. result := false;
  4024. end;
  4025. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4026. function TglBitmap.FlipVert: Boolean;
  4027. begin
  4028. result := false;
  4029. end;
  4030. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4031. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4032. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4033. procedure TglBitmap.AfterConstruction;
  4034. begin
  4035. inherited AfterConstruction;
  4036. fID := 0;
  4037. fTarget := 0;
  4038. {$IFNDEF OPENGL_ES}
  4039. fIsResident := false;
  4040. {$ENDIF}
  4041. fMipMap := glBitmapDefaultMipmap;
  4042. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  4043. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  4044. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  4045. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  4046. {$IFNDEF OPENGL_ES}
  4047. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  4048. {$ENDIF}
  4049. end;
  4050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4051. procedure TglBitmap.BeforeDestruction;
  4052. var
  4053. NewData: PByte;
  4054. begin
  4055. if fFreeDataOnDestroy then begin
  4056. NewData := nil;
  4057. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  4058. end;
  4059. if (fID > 0) and fDeleteTextureOnFree then
  4060. glDeleteTextures(1, @fID);
  4061. inherited BeforeDestruction;
  4062. end;
  4063. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4064. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  4065. var
  4066. TempPos: Integer;
  4067. begin
  4068. if not Assigned(aResType) then begin
  4069. TempPos := Pos('.', aResource);
  4070. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  4071. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  4072. end;
  4073. end;
  4074. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4075. procedure TglBitmap.LoadFromFile(const aFilename: String);
  4076. var
  4077. fs: TFileStream;
  4078. begin
  4079. if not FileExists(aFilename) then
  4080. raise EglBitmap.Create('file does not exist: ' + aFilename);
  4081. fFilename := aFilename;
  4082. fs := TFileStream.Create(fFilename, fmOpenRead);
  4083. try
  4084. fs.Position := 0;
  4085. LoadFromStream(fs);
  4086. finally
  4087. fs.Free;
  4088. end;
  4089. end;
  4090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4091. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  4092. begin
  4093. {$IFDEF GLB_SUPPORT_PNG_READ}
  4094. if not LoadPNG(aStream) then
  4095. {$ENDIF}
  4096. {$IFDEF GLB_SUPPORT_JPEG_READ}
  4097. if not LoadJPEG(aStream) then
  4098. {$ENDIF}
  4099. if not LoadDDS(aStream) then
  4100. if not LoadTGA(aStream) then
  4101. if not LoadBMP(aStream) then
  4102. if not LoadRAW(aStream) then
  4103. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  4104. end;
  4105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4106. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapSize; const aFunc: TglBitmapFunction;
  4107. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  4108. var
  4109. tmpData: PByte;
  4110. size: Integer;
  4111. begin
  4112. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4113. GetMem(tmpData, size);
  4114. try
  4115. FillChar(tmpData^, size, #$FF);
  4116. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4117. except
  4118. if Assigned(tmpData) then
  4119. FreeMem(tmpData);
  4120. raise;
  4121. end;
  4122. Convert(Self, aFunc, false, aFormat, aArgs);
  4123. end;
  4124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4125. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  4126. var
  4127. rs: TResourceStream;
  4128. begin
  4129. PrepareResType(aResource, aResType);
  4130. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4131. try
  4132. LoadFromStream(rs);
  4133. finally
  4134. rs.Free;
  4135. end;
  4136. end;
  4137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4138. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4139. var
  4140. rs: TResourceStream;
  4141. begin
  4142. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4143. try
  4144. LoadFromStream(rs);
  4145. finally
  4146. rs.Free;
  4147. end;
  4148. end;
  4149. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4150. procedure TglBitmap.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
  4151. var
  4152. fs: TFileStream;
  4153. begin
  4154. fs := TFileStream.Create(aFileName, fmCreate);
  4155. try
  4156. fs.Position := 0;
  4157. SaveToStream(fs, aFileType);
  4158. finally
  4159. fs.Free;
  4160. end;
  4161. end;
  4162. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4163. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  4164. begin
  4165. case aFileType of
  4166. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4167. ftPNG: SavePNG(aStream);
  4168. {$ENDIF}
  4169. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  4170. ftJPEG: SaveJPEG(aStream);
  4171. {$ENDIF}
  4172. ftDDS: SaveDDS(aStream);
  4173. ftTGA: SaveTGA(aStream);
  4174. ftBMP: SaveBMP(aStream);
  4175. ftRAW: SaveRAW(aStream);
  4176. end;
  4177. end;
  4178. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4179. function TglBitmap.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  4180. begin
  4181. result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
  4182. end;
  4183. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4184. function TglBitmap.Convert(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  4185. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  4186. var
  4187. DestData, TmpData, SourceData: pByte;
  4188. TempHeight, TempWidth: Integer;
  4189. SourceFD, DestFD: TFormatDescriptor;
  4190. SourceMD, DestMD: Pointer;
  4191. FuncRec: TglBitmapFunctionRec;
  4192. begin
  4193. Assert(Assigned(Data));
  4194. Assert(Assigned(aSource));
  4195. Assert(Assigned(aSource.Data));
  4196. result := false;
  4197. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  4198. SourceFD := TFormatDescriptor.Get(aSource.Format);
  4199. DestFD := TFormatDescriptor.Get(aFormat);
  4200. if (SourceFD.IsCompressed) then
  4201. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  4202. if (DestFD.IsCompressed) then
  4203. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  4204. // inkompatible Formats so CreateTemp
  4205. if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
  4206. aCreateTemp := true;
  4207. // Values
  4208. TempHeight := Max(1, aSource.Height);
  4209. TempWidth := Max(1, aSource.Width);
  4210. FuncRec.Sender := Self;
  4211. FuncRec.Args := aArgs;
  4212. TmpData := nil;
  4213. if aCreateTemp then begin
  4214. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  4215. DestData := TmpData;
  4216. end else
  4217. DestData := Data;
  4218. try
  4219. SourceFD.PreparePixel(FuncRec.Source);
  4220. DestFD.PreparePixel (FuncRec.Dest);
  4221. SourceMD := SourceFD.CreateMappingData;
  4222. DestMD := DestFD.CreateMappingData;
  4223. FuncRec.Size := aSource.Dimension;
  4224. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4225. try
  4226. SourceData := aSource.Data;
  4227. FuncRec.Position.Y := 0;
  4228. while FuncRec.Position.Y < TempHeight do begin
  4229. FuncRec.Position.X := 0;
  4230. while FuncRec.Position.X < TempWidth do begin
  4231. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4232. aFunc(FuncRec);
  4233. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  4234. inc(FuncRec.Position.X);
  4235. end;
  4236. inc(FuncRec.Position.Y);
  4237. end;
  4238. // Updating Image or InternalFormat
  4239. if aCreateTemp then
  4240. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  4241. else if (aFormat <> fFormat) then
  4242. Format := aFormat;
  4243. result := true;
  4244. finally
  4245. SourceFD.FreeMappingData(SourceMD);
  4246. DestFD.FreeMappingData(DestMD);
  4247. end;
  4248. except
  4249. if aCreateTemp and Assigned(TmpData) then
  4250. FreeMem(TmpData);
  4251. raise;
  4252. end;
  4253. end;
  4254. end;
  4255. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4256. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4257. var
  4258. SourceFD, DestFD: TFormatDescriptor;
  4259. SourcePD, DestPD: TglBitmapPixelData;
  4260. ShiftData: TShiftData;
  4261. function DataIsIdentical: Boolean;
  4262. begin
  4263. result := SourceFD.MaskMatch(DestFD.Mask);
  4264. end;
  4265. function CanCopyDirect: Boolean;
  4266. begin
  4267. result :=
  4268. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4269. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4270. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4271. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4272. end;
  4273. function CanShift: Boolean;
  4274. begin
  4275. result :=
  4276. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4277. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4278. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4279. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4280. end;
  4281. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4282. begin
  4283. result := 0;
  4284. while (aSource > aDest) and (aSource > 0) do begin
  4285. inc(result);
  4286. aSource := aSource shr 1;
  4287. end;
  4288. end;
  4289. begin
  4290. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4291. SourceFD := TFormatDescriptor.Get(Format);
  4292. DestFD := TFormatDescriptor.Get(aFormat);
  4293. if DataIsIdentical then begin
  4294. result := true;
  4295. Format := aFormat;
  4296. exit;
  4297. end;
  4298. SourceFD.PreparePixel(SourcePD);
  4299. DestFD.PreparePixel (DestPD);
  4300. if CanCopyDirect then
  4301. result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
  4302. else if CanShift then begin
  4303. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4304. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4305. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4306. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4307. result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4308. end else
  4309. result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4310. end else
  4311. result := true;
  4312. end;
  4313. {$IFDEF GLB_SDL}
  4314. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4315. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  4316. var
  4317. Row, RowSize: Integer;
  4318. SourceData, TmpData: PByte;
  4319. TempDepth: Integer;
  4320. FormatDesc: TFormatDescriptor;
  4321. function GetRowPointer(Row: Integer): pByte;
  4322. begin
  4323. result := aSurface.pixels;
  4324. Inc(result, Row * RowSize);
  4325. end;
  4326. begin
  4327. result := false;
  4328. FormatDesc := TFormatDescriptor.Get(Format);
  4329. if FormatDesc.IsCompressed then
  4330. raise EglBitmapUnsupportedFormat.Create(Format);
  4331. if Assigned(Data) then begin
  4332. case Trunc(FormatDesc.PixelSize) of
  4333. 1: TempDepth := 8;
  4334. 2: TempDepth := 16;
  4335. 3: TempDepth := 24;
  4336. 4: TempDepth := 32;
  4337. else
  4338. raise EglBitmapUnsupportedFormat.Create(Format);
  4339. end;
  4340. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4341. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4342. SourceData := Data;
  4343. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4344. for Row := 0 to FileHeight-1 do begin
  4345. TmpData := GetRowPointer(Row);
  4346. if Assigned(TmpData) then begin
  4347. Move(SourceData^, TmpData^, RowSize);
  4348. inc(SourceData, RowSize);
  4349. end;
  4350. end;
  4351. result := true;
  4352. end;
  4353. end;
  4354. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4355. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4356. var
  4357. pSource, pData, pTempData: PByte;
  4358. Row, RowSize, TempWidth, TempHeight: Integer;
  4359. IntFormat: TglBitmapFormat;
  4360. fd: TFormatDescriptor;
  4361. Mask: TglBitmapMask;
  4362. function GetRowPointer(Row: Integer): pByte;
  4363. begin
  4364. result := aSurface^.pixels;
  4365. Inc(result, Row * RowSize);
  4366. end;
  4367. begin
  4368. result := false;
  4369. if (Assigned(aSurface)) then begin
  4370. with aSurface^.format^ do begin
  4371. Mask.r := RMask;
  4372. Mask.g := GMask;
  4373. Mask.b := BMask;
  4374. Mask.a := AMask;
  4375. IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
  4376. if (IntFormat = tfEmpty) then
  4377. raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
  4378. end;
  4379. fd := TFormatDescriptor.Get(IntFormat);
  4380. TempWidth := aSurface^.w;
  4381. TempHeight := aSurface^.h;
  4382. RowSize := fd.GetSize(TempWidth, 1);
  4383. GetMem(pData, TempHeight * RowSize);
  4384. try
  4385. pTempData := pData;
  4386. for Row := 0 to TempHeight -1 do begin
  4387. pSource := GetRowPointer(Row);
  4388. if (Assigned(pSource)) then begin
  4389. Move(pSource^, pTempData^, RowSize);
  4390. Inc(pTempData, RowSize);
  4391. end;
  4392. end;
  4393. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4394. result := true;
  4395. except
  4396. if Assigned(pData) then
  4397. FreeMem(pData);
  4398. raise;
  4399. end;
  4400. end;
  4401. end;
  4402. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4403. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4404. var
  4405. Row, Col, AlphaInterleave: Integer;
  4406. pSource, pDest: PByte;
  4407. function GetRowPointer(Row: Integer): pByte;
  4408. begin
  4409. result := aSurface.pixels;
  4410. Inc(result, Row * Width);
  4411. end;
  4412. begin
  4413. result := false;
  4414. if Assigned(Data) then begin
  4415. if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
  4416. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4417. AlphaInterleave := 0;
  4418. case Format of
  4419. tfLuminance8Alpha8ub2:
  4420. AlphaInterleave := 1;
  4421. tfBGRA8ub4, tfRGBA8ub4:
  4422. AlphaInterleave := 3;
  4423. end;
  4424. pSource := Data;
  4425. for Row := 0 to Height -1 do begin
  4426. pDest := GetRowPointer(Row);
  4427. if Assigned(pDest) then begin
  4428. for Col := 0 to Width -1 do begin
  4429. Inc(pSource, AlphaInterleave);
  4430. pDest^ := pSource^;
  4431. Inc(pDest);
  4432. Inc(pSource);
  4433. end;
  4434. end;
  4435. end;
  4436. result := true;
  4437. end;
  4438. end;
  4439. end;
  4440. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4441. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4442. var
  4443. bmp: TglBitmap2D;
  4444. begin
  4445. bmp := TglBitmap2D.Create;
  4446. try
  4447. bmp.AssignFromSurface(aSurface);
  4448. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4449. finally
  4450. bmp.Free;
  4451. end;
  4452. end;
  4453. {$ENDIF}
  4454. {$IFDEF GLB_DELPHI}
  4455. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4456. function CreateGrayPalette: HPALETTE;
  4457. var
  4458. Idx: Integer;
  4459. Pal: PLogPalette;
  4460. begin
  4461. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4462. Pal.palVersion := $300;
  4463. Pal.palNumEntries := 256;
  4464. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4465. Pal.palPalEntry[Idx].peRed := Idx;
  4466. Pal.palPalEntry[Idx].peGreen := Idx;
  4467. Pal.palPalEntry[Idx].peBlue := Idx;
  4468. Pal.palPalEntry[Idx].peFlags := 0;
  4469. end;
  4470. Result := CreatePalette(Pal^);
  4471. FreeMem(Pal);
  4472. end;
  4473. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4474. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4475. var
  4476. Row: Integer;
  4477. pSource, pData: PByte;
  4478. begin
  4479. result := false;
  4480. if Assigned(Data) then begin
  4481. if Assigned(aBitmap) then begin
  4482. aBitmap.Width := Width;
  4483. aBitmap.Height := Height;
  4484. case Format of
  4485. tfAlpha8ub1, tfLuminance8ub1: begin
  4486. aBitmap.PixelFormat := pf8bit;
  4487. aBitmap.Palette := CreateGrayPalette;
  4488. end;
  4489. tfRGB5A1us1:
  4490. aBitmap.PixelFormat := pf15bit;
  4491. tfR5G6B5us1:
  4492. aBitmap.PixelFormat := pf16bit;
  4493. tfRGB8ub3, tfBGR8ub3:
  4494. aBitmap.PixelFormat := pf24bit;
  4495. tfRGBA8ub4, tfBGRA8ub4:
  4496. aBitmap.PixelFormat := pf32bit;
  4497. else
  4498. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4499. end;
  4500. pSource := Data;
  4501. for Row := 0 to FileHeight -1 do begin
  4502. pData := aBitmap.Scanline[Row];
  4503. Move(pSource^, pData^, fRowSize);
  4504. Inc(pSource, fRowSize);
  4505. if (Format in [tfRGB8ub3, tfRGBA8ub4]) then // swap RGB(A) to BGR(A)
  4506. SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
  4507. end;
  4508. result := true;
  4509. end;
  4510. end;
  4511. end;
  4512. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4513. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4514. var
  4515. pSource, pData, pTempData: PByte;
  4516. Row, RowSize, TempWidth, TempHeight: Integer;
  4517. IntFormat: TglBitmapFormat;
  4518. begin
  4519. result := false;
  4520. if (Assigned(aBitmap)) then begin
  4521. case aBitmap.PixelFormat of
  4522. pf8bit:
  4523. IntFormat := tfLuminance8ub1;
  4524. pf15bit:
  4525. IntFormat := tfRGB5A1us1;
  4526. pf16bit:
  4527. IntFormat := tfR5G6B5us1;
  4528. pf24bit:
  4529. IntFormat := tfBGR8ub3;
  4530. pf32bit:
  4531. IntFormat := tfBGRA8ub4;
  4532. else
  4533. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4534. end;
  4535. TempWidth := aBitmap.Width;
  4536. TempHeight := aBitmap.Height;
  4537. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4538. GetMem(pData, TempHeight * RowSize);
  4539. try
  4540. pTempData := pData;
  4541. for Row := 0 to TempHeight -1 do begin
  4542. pSource := aBitmap.Scanline[Row];
  4543. if (Assigned(pSource)) then begin
  4544. Move(pSource^, pTempData^, RowSize);
  4545. Inc(pTempData, RowSize);
  4546. end;
  4547. end;
  4548. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4549. result := true;
  4550. except
  4551. if Assigned(pData) then
  4552. FreeMem(pData);
  4553. raise;
  4554. end;
  4555. end;
  4556. end;
  4557. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4558. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4559. var
  4560. Row, Col, AlphaInterleave: Integer;
  4561. pSource, pDest: PByte;
  4562. begin
  4563. result := false;
  4564. if Assigned(Data) then begin
  4565. if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
  4566. if Assigned(aBitmap) then begin
  4567. aBitmap.PixelFormat := pf8bit;
  4568. aBitmap.Palette := CreateGrayPalette;
  4569. aBitmap.Width := Width;
  4570. aBitmap.Height := Height;
  4571. case Format of
  4572. tfLuminance8Alpha8ub2:
  4573. AlphaInterleave := 1;
  4574. tfRGBA8ub4, tfBGRA8ub4:
  4575. AlphaInterleave := 3;
  4576. else
  4577. AlphaInterleave := 0;
  4578. end;
  4579. // Copy Data
  4580. pSource := Data;
  4581. for Row := 0 to Height -1 do begin
  4582. pDest := aBitmap.Scanline[Row];
  4583. if Assigned(pDest) then begin
  4584. for Col := 0 to Width -1 do begin
  4585. Inc(pSource, AlphaInterleave);
  4586. pDest^ := pSource^;
  4587. Inc(pDest);
  4588. Inc(pSource);
  4589. end;
  4590. end;
  4591. end;
  4592. result := true;
  4593. end;
  4594. end;
  4595. end;
  4596. end;
  4597. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4598. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4599. var
  4600. tex: TglBitmap2D;
  4601. begin
  4602. tex := TglBitmap2D.Create;
  4603. try
  4604. tex.AssignFromBitmap(ABitmap);
  4605. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4606. finally
  4607. tex.Free;
  4608. end;
  4609. end;
  4610. {$ENDIF}
  4611. {$IFDEF GLB_LAZARUS}
  4612. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4613. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4614. var
  4615. rid: TRawImageDescription;
  4616. FormatDesc: TFormatDescriptor;
  4617. begin
  4618. if not Assigned(Data) then
  4619. raise EglBitmap.Create('no pixel data assigned. load data before save');
  4620. result := false;
  4621. if not Assigned(aImage) or (Format = tfEmpty) then
  4622. exit;
  4623. FormatDesc := TFormatDescriptor.Get(Format);
  4624. if FormatDesc.IsCompressed then
  4625. exit;
  4626. FillChar(rid{%H-}, SizeOf(rid), 0);
  4627. if FormatDesc.IsGrayscale then
  4628. rid.Format := ricfGray
  4629. else
  4630. rid.Format := ricfRGBA;
  4631. rid.Width := Width;
  4632. rid.Height := Height;
  4633. rid.Depth := FormatDesc.BitsPerPixel;
  4634. rid.BitOrder := riboBitsInOrder;
  4635. rid.ByteOrder := riboLSBFirst;
  4636. rid.LineOrder := riloTopToBottom;
  4637. rid.LineEnd := rileTight;
  4638. rid.BitsPerPixel := FormatDesc.BitsPerPixel;
  4639. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4640. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4641. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4642. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4643. rid.RedShift := FormatDesc.Shift.r;
  4644. rid.GreenShift := FormatDesc.Shift.g;
  4645. rid.BlueShift := FormatDesc.Shift.b;
  4646. rid.AlphaShift := FormatDesc.Shift.a;
  4647. rid.MaskBitsPerPixel := 0;
  4648. rid.PaletteColorCount := 0;
  4649. aImage.DataDescription := rid;
  4650. aImage.CreateData;
  4651. if not Assigned(aImage.PixelData) then
  4652. raise EglBitmap.Create('error while creating LazIntfImage');
  4653. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4654. result := true;
  4655. end;
  4656. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4657. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4658. var
  4659. f: TglBitmapFormat;
  4660. FormatDesc: TFormatDescriptor;
  4661. ImageData: PByte;
  4662. ImageSize: Integer;
  4663. CanCopy: Boolean;
  4664. Mask: TglBitmapRec4ul;
  4665. procedure CopyConvert;
  4666. var
  4667. bfFormat: TbmpBitfieldFormat;
  4668. pSourceLine, pDestLine: PByte;
  4669. pSourceMD, pDestMD: Pointer;
  4670. Shift, Prec: TglBitmapRec4ub;
  4671. x, y: Integer;
  4672. pixel: TglBitmapPixelData;
  4673. begin
  4674. bfFormat := TbmpBitfieldFormat.Create;
  4675. with aImage.DataDescription do begin
  4676. Prec.r := RedPrec;
  4677. Prec.g := GreenPrec;
  4678. Prec.b := BluePrec;
  4679. Prec.a := AlphaPrec;
  4680. Shift.r := RedShift;
  4681. Shift.g := GreenShift;
  4682. Shift.b := BlueShift;
  4683. Shift.a := AlphaShift;
  4684. bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
  4685. end;
  4686. pSourceMD := bfFormat.CreateMappingData;
  4687. pDestMD := FormatDesc.CreateMappingData;
  4688. try
  4689. for y := 0 to aImage.Height-1 do begin
  4690. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  4691. pDestLine := ImageData + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
  4692. for x := 0 to aImage.Width-1 do begin
  4693. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  4694. FormatDesc.Map(pixel, pDestLine, pDestMD);
  4695. end;
  4696. end;
  4697. finally
  4698. FormatDesc.FreeMappingData(pDestMD);
  4699. bfFormat.FreeMappingData(pSourceMD);
  4700. bfFormat.Free;
  4701. end;
  4702. end;
  4703. begin
  4704. result := false;
  4705. if not Assigned(aImage) then
  4706. exit;
  4707. with aImage.DataDescription do begin
  4708. Mask.r := (QWord(1 shl RedPrec )-1) shl RedShift;
  4709. Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
  4710. Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
  4711. Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
  4712. end;
  4713. FormatDesc := TFormatDescriptor.GetFromMask(Mask);
  4714. f := FormatDesc.Format;
  4715. if (f = tfEmpty) then
  4716. exit;
  4717. CanCopy :=
  4718. (FormatDesc.BitsPerPixel = aImage.DataDescription.Depth) and
  4719. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  4720. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4721. ImageData := GetMem(ImageSize);
  4722. try
  4723. if CanCopy then
  4724. Move(aImage.PixelData^, ImageData^, ImageSize)
  4725. else
  4726. CopyConvert;
  4727. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4728. except
  4729. if Assigned(ImageData) then
  4730. FreeMem(ImageData);
  4731. raise;
  4732. end;
  4733. result := true;
  4734. end;
  4735. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4736. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4737. var
  4738. rid: TRawImageDescription;
  4739. FormatDesc: TFormatDescriptor;
  4740. Pixel: TglBitmapPixelData;
  4741. x, y: Integer;
  4742. srcMD: Pointer;
  4743. src, dst: PByte;
  4744. begin
  4745. result := false;
  4746. if not Assigned(aImage) or (Format = tfEmpty) then
  4747. exit;
  4748. FormatDesc := TFormatDescriptor.Get(Format);
  4749. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4750. exit;
  4751. FillChar(rid{%H-}, SizeOf(rid), 0);
  4752. rid.Format := ricfGray;
  4753. rid.Width := Width;
  4754. rid.Height := Height;
  4755. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4756. rid.BitOrder := riboBitsInOrder;
  4757. rid.ByteOrder := riboLSBFirst;
  4758. rid.LineOrder := riloTopToBottom;
  4759. rid.LineEnd := rileTight;
  4760. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4761. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4762. rid.GreenPrec := 0;
  4763. rid.BluePrec := 0;
  4764. rid.AlphaPrec := 0;
  4765. rid.RedShift := 0;
  4766. rid.GreenShift := 0;
  4767. rid.BlueShift := 0;
  4768. rid.AlphaShift := 0;
  4769. rid.MaskBitsPerPixel := 0;
  4770. rid.PaletteColorCount := 0;
  4771. aImage.DataDescription := rid;
  4772. aImage.CreateData;
  4773. srcMD := FormatDesc.CreateMappingData;
  4774. try
  4775. FormatDesc.PreparePixel(Pixel);
  4776. src := Data;
  4777. dst := aImage.PixelData;
  4778. for y := 0 to Height-1 do
  4779. for x := 0 to Width-1 do begin
  4780. FormatDesc.Unmap(src, Pixel, srcMD);
  4781. case rid.BitsPerPixel of
  4782. 8: begin
  4783. dst^ := Pixel.Data.a;
  4784. inc(dst);
  4785. end;
  4786. 16: begin
  4787. PWord(dst)^ := Pixel.Data.a;
  4788. inc(dst, 2);
  4789. end;
  4790. 24: begin
  4791. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4792. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4793. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4794. inc(dst, 3);
  4795. end;
  4796. 32: begin
  4797. PCardinal(dst)^ := Pixel.Data.a;
  4798. inc(dst, 4);
  4799. end;
  4800. else
  4801. raise EglBitmapUnsupportedFormat.Create(Format);
  4802. end;
  4803. end;
  4804. finally
  4805. FormatDesc.FreeMappingData(srcMD);
  4806. end;
  4807. result := true;
  4808. end;
  4809. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4810. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4811. var
  4812. tex: TglBitmap2D;
  4813. begin
  4814. tex := TglBitmap2D.Create;
  4815. try
  4816. tex.AssignFromLazIntfImage(aImage);
  4817. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4818. finally
  4819. tex.Free;
  4820. end;
  4821. end;
  4822. {$ENDIF}
  4823. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4824. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4825. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4826. var
  4827. rs: TResourceStream;
  4828. begin
  4829. PrepareResType(aResource, aResType);
  4830. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4831. try
  4832. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4833. finally
  4834. rs.Free;
  4835. end;
  4836. end;
  4837. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4838. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4839. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4840. var
  4841. rs: TResourceStream;
  4842. begin
  4843. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4844. try
  4845. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4846. finally
  4847. rs.Free;
  4848. end;
  4849. end;
  4850. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4851. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4852. begin
  4853. if TFormatDescriptor.Get(Format).IsCompressed then
  4854. raise EglBitmapUnsupportedFormat.Create(Format);
  4855. result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4856. end;
  4857. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4858. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4859. var
  4860. FS: TFileStream;
  4861. begin
  4862. FS := TFileStream.Create(aFileName, fmOpenRead);
  4863. try
  4864. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4865. finally
  4866. FS.Free;
  4867. end;
  4868. end;
  4869. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4870. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4871. var
  4872. tex: TglBitmap2D;
  4873. begin
  4874. tex := TglBitmap2D.Create(aStream);
  4875. try
  4876. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4877. finally
  4878. tex.Free;
  4879. end;
  4880. end;
  4881. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4882. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4883. var
  4884. DestData, DestData2, SourceData: pByte;
  4885. TempHeight, TempWidth: Integer;
  4886. SourceFD, DestFD: TFormatDescriptor;
  4887. SourceMD, DestMD, DestMD2: Pointer;
  4888. FuncRec: TglBitmapFunctionRec;
  4889. begin
  4890. result := false;
  4891. Assert(Assigned(Data));
  4892. Assert(Assigned(aBitmap));
  4893. Assert(Assigned(aBitmap.Data));
  4894. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4895. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4896. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4897. DestFD := TFormatDescriptor.Get(Format);
  4898. if not Assigned(aFunc) then begin
  4899. aFunc := glBitmapAlphaFunc;
  4900. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4901. end else
  4902. FuncRec.Args := aArgs;
  4903. // Values
  4904. TempHeight := aBitmap.FileHeight;
  4905. TempWidth := aBitmap.FileWidth;
  4906. FuncRec.Sender := Self;
  4907. FuncRec.Size := Dimension;
  4908. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4909. DestData := Data;
  4910. DestData2 := Data;
  4911. SourceData := aBitmap.Data;
  4912. // Mapping
  4913. SourceFD.PreparePixel(FuncRec.Source);
  4914. DestFD.PreparePixel (FuncRec.Dest);
  4915. SourceMD := SourceFD.CreateMappingData;
  4916. DestMD := DestFD.CreateMappingData;
  4917. DestMD2 := DestFD.CreateMappingData;
  4918. try
  4919. FuncRec.Position.Y := 0;
  4920. while FuncRec.Position.Y < TempHeight do begin
  4921. FuncRec.Position.X := 0;
  4922. while FuncRec.Position.X < TempWidth do begin
  4923. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4924. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4925. aFunc(FuncRec);
  4926. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4927. inc(FuncRec.Position.X);
  4928. end;
  4929. inc(FuncRec.Position.Y);
  4930. end;
  4931. finally
  4932. SourceFD.FreeMappingData(SourceMD);
  4933. DestFD.FreeMappingData(DestMD);
  4934. DestFD.FreeMappingData(DestMD2);
  4935. end;
  4936. end;
  4937. end;
  4938. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4939. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4940. begin
  4941. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4942. end;
  4943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4944. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4945. var
  4946. PixelData: TglBitmapPixelData;
  4947. begin
  4948. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  4949. result := AddAlphaFromColorKeyFloat(
  4950. aRed / PixelData.Range.r,
  4951. aGreen / PixelData.Range.g,
  4952. aBlue / PixelData.Range.b,
  4953. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4954. end;
  4955. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4956. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4957. var
  4958. values: array[0..2] of Single;
  4959. tmp: Cardinal;
  4960. i: Integer;
  4961. PixelData: TglBitmapPixelData;
  4962. begin
  4963. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  4964. with PixelData do begin
  4965. values[0] := aRed;
  4966. values[1] := aGreen;
  4967. values[2] := aBlue;
  4968. for i := 0 to 2 do begin
  4969. tmp := Trunc(Range.arr[i] * aDeviation);
  4970. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4971. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4972. end;
  4973. Data.a := 0;
  4974. Range.a := 0;
  4975. end;
  4976. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4977. end;
  4978. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4979. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4980. begin
  4981. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4982. end;
  4983. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4984. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4985. var
  4986. PixelData: TglBitmapPixelData;
  4987. begin
  4988. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  4989. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4990. end;
  4991. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4992. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4993. var
  4994. PixelData: TglBitmapPixelData;
  4995. begin
  4996. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  4997. with PixelData do
  4998. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4999. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  5000. end;
  5001. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5002. function TglBitmap.RemoveAlpha: Boolean;
  5003. var
  5004. FormatDesc: TFormatDescriptor;
  5005. begin
  5006. result := false;
  5007. FormatDesc := TFormatDescriptor.Get(Format);
  5008. if Assigned(Data) then begin
  5009. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  5010. raise EglBitmapUnsupportedFormat.Create(Format);
  5011. result := ConvertTo(FormatDesc.WithoutAlpha);
  5012. end;
  5013. end;
  5014. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5015. function TglBitmap.Clone: TglBitmap;
  5016. var
  5017. Temp: TglBitmap;
  5018. TempPtr: PByte;
  5019. Size: Integer;
  5020. begin
  5021. result := nil;
  5022. Temp := (ClassType.Create as TglBitmap);
  5023. try
  5024. // copy texture data if assigned
  5025. if Assigned(Data) then begin
  5026. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  5027. GetMem(TempPtr, Size);
  5028. try
  5029. Move(Data^, TempPtr^, Size);
  5030. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  5031. except
  5032. if Assigned(TempPtr) then
  5033. FreeMem(TempPtr);
  5034. raise;
  5035. end;
  5036. end else begin
  5037. TempPtr := nil;
  5038. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  5039. end;
  5040. // copy properties
  5041. Temp.fID := ID;
  5042. Temp.fTarget := Target;
  5043. Temp.fFormat := Format;
  5044. Temp.fMipMap := MipMap;
  5045. Temp.fAnisotropic := Anisotropic;
  5046. Temp.fBorderColor := fBorderColor;
  5047. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  5048. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  5049. Temp.fFilterMin := fFilterMin;
  5050. Temp.fFilterMag := fFilterMag;
  5051. Temp.fWrapS := fWrapS;
  5052. Temp.fWrapT := fWrapT;
  5053. Temp.fWrapR := fWrapR;
  5054. Temp.fFilename := fFilename;
  5055. Temp.fCustomName := fCustomName;
  5056. Temp.fCustomNameW := fCustomNameW;
  5057. Temp.fCustomData := fCustomData;
  5058. result := Temp;
  5059. except
  5060. FreeAndNil(Temp);
  5061. raise;
  5062. end;
  5063. end;
  5064. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5065. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  5066. begin
  5067. if aUseRGB or aUseAlpha then
  5068. Convert(glBitmapInvertFunc, false, {%H-}Pointer(
  5069. ((Byte(aUseAlpha) and 1) shl 1) or
  5070. (Byte(aUseRGB) and 1) ));
  5071. end;
  5072. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5073. procedure TglBitmap.FreeData;
  5074. var
  5075. TempPtr: PByte;
  5076. begin
  5077. TempPtr := nil;
  5078. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  5079. end;
  5080. {$IFNDEF OPENGL_ES}
  5081. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5082. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  5083. begin
  5084. fBorderColor[0] := aRed;
  5085. fBorderColor[1] := aGreen;
  5086. fBorderColor[2] := aBlue;
  5087. fBorderColor[3] := aAlpha;
  5088. if (ID > 0) then begin
  5089. Bind(false);
  5090. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  5091. end;
  5092. end;
  5093. {$ENDIF}
  5094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5095. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  5096. const aAlpha: Byte);
  5097. begin
  5098. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  5099. end;
  5100. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5101. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  5102. var
  5103. PixelData: TglBitmapPixelData;
  5104. begin
  5105. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5106. FillWithColorFloat(
  5107. aRed / PixelData.Range.r,
  5108. aGreen / PixelData.Range.g,
  5109. aBlue / PixelData.Range.b,
  5110. aAlpha / PixelData.Range.a);
  5111. end;
  5112. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5113. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  5114. var
  5115. PixelData: TglBitmapPixelData;
  5116. begin
  5117. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  5118. with PixelData do begin
  5119. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  5120. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  5121. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  5122. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  5123. end;
  5124. Convert(glBitmapFillWithColorFunc, false, @PixelData);
  5125. end;
  5126. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5127. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  5128. begin
  5129. //check MIN filter
  5130. case aMin of
  5131. GL_NEAREST:
  5132. fFilterMin := GL_NEAREST;
  5133. GL_LINEAR:
  5134. fFilterMin := GL_LINEAR;
  5135. GL_NEAREST_MIPMAP_NEAREST:
  5136. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  5137. GL_LINEAR_MIPMAP_NEAREST:
  5138. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  5139. GL_NEAREST_MIPMAP_LINEAR:
  5140. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  5141. GL_LINEAR_MIPMAP_LINEAR:
  5142. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  5143. else
  5144. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  5145. end;
  5146. //check MAG filter
  5147. case aMag of
  5148. GL_NEAREST:
  5149. fFilterMag := GL_NEAREST;
  5150. GL_LINEAR:
  5151. fFilterMag := GL_LINEAR;
  5152. else
  5153. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  5154. end;
  5155. //apply filter
  5156. if (ID > 0) then begin
  5157. Bind(false);
  5158. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  5159. if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
  5160. case fFilterMin of
  5161. GL_NEAREST, GL_LINEAR:
  5162. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5163. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  5164. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  5165. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  5166. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  5167. end;
  5168. end else
  5169. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5170. end;
  5171. end;
  5172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5173. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  5174. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  5175. begin
  5176. case aValue of
  5177. {$IFNDEF OPENGL_ES}
  5178. GL_CLAMP:
  5179. aTarget := GL_CLAMP;
  5180. {$ENDIF}
  5181. GL_REPEAT:
  5182. aTarget := GL_REPEAT;
  5183. GL_CLAMP_TO_EDGE: begin
  5184. {$IFNDEF OPENGL_ES}
  5185. if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
  5186. aTarget := GL_CLAMP
  5187. else
  5188. {$ENDIF}
  5189. aTarget := GL_CLAMP_TO_EDGE;
  5190. end;
  5191. {$IFNDEF OPENGL_ES}
  5192. GL_CLAMP_TO_BORDER: begin
  5193. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  5194. aTarget := GL_CLAMP_TO_BORDER
  5195. else
  5196. aTarget := GL_CLAMP;
  5197. end;
  5198. {$ENDIF}
  5199. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  5200. GL_MIRRORED_REPEAT: begin
  5201. {$IFNDEF OPENGL_ES}
  5202. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  5203. {$ELSE}
  5204. if GL_VERSION_2_0 then
  5205. {$ENDIF}
  5206. aTarget := GL_MIRRORED_REPEAT
  5207. else
  5208. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  5209. end;
  5210. {$IFEND}
  5211. else
  5212. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  5213. end;
  5214. end;
  5215. begin
  5216. CheckAndSetWrap(S, fWrapS);
  5217. CheckAndSetWrap(T, fWrapT);
  5218. CheckAndSetWrap(R, fWrapR);
  5219. if (ID > 0) then begin
  5220. Bind(false);
  5221. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  5222. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  5223. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  5224. {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
  5225. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  5226. {$IFEND}
  5227. end;
  5228. end;
  5229. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  5230. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5231. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  5232. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  5233. begin
  5234. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  5235. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  5236. fSwizzle[aIndex] := aValue
  5237. else
  5238. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  5239. end;
  5240. begin
  5241. {$IFNDEF OPENGL_ES}
  5242. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  5243. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  5244. {$ELSE}
  5245. if not GL_VERSION_3_0 then
  5246. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  5247. {$ENDIF}
  5248. CheckAndSetValue(r, 0);
  5249. CheckAndSetValue(g, 1);
  5250. CheckAndSetValue(b, 2);
  5251. CheckAndSetValue(a, 3);
  5252. if (ID > 0) then begin
  5253. Bind(false);
  5254. {$IFNDEF OPENGL_ES}
  5255. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  5256. {$ELSE}
  5257. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
  5258. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
  5259. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
  5260. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
  5261. {$ENDIF}
  5262. end;
  5263. end;
  5264. {$IFEND}
  5265. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5266. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  5267. begin
  5268. if aEnableTextureUnit then
  5269. glEnable(Target);
  5270. if (ID > 0) then
  5271. glBindTexture(Target, ID);
  5272. end;
  5273. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5274. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  5275. begin
  5276. if aDisableTextureUnit then
  5277. glDisable(Target);
  5278. glBindTexture(Target, 0);
  5279. end;
  5280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5281. constructor TglBitmap.Create;
  5282. begin
  5283. if (ClassType = TglBitmap) then
  5284. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  5285. inherited Create;
  5286. fFormat := glBitmapGetDefaultFormat;
  5287. fFreeDataOnDestroy := true;
  5288. end;
  5289. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5290. constructor TglBitmap.Create(const aFileName: String);
  5291. begin
  5292. Create;
  5293. LoadFromFile(aFileName);
  5294. end;
  5295. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5296. constructor TglBitmap.Create(const aStream: TStream);
  5297. begin
  5298. Create;
  5299. LoadFromStream(aStream);
  5300. end;
  5301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5302. constructor TglBitmap.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
  5303. var
  5304. ImageSize: Integer;
  5305. begin
  5306. Create;
  5307. if not Assigned(aData) then begin
  5308. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5309. GetMem(aData, ImageSize);
  5310. try
  5311. FillChar(aData^, ImageSize, #$FF);
  5312. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5313. except
  5314. if Assigned(aData) then
  5315. FreeMem(aData);
  5316. raise;
  5317. end;
  5318. end else begin
  5319. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5320. end;
  5321. end;
  5322. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5323. constructor TglBitmap.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5324. begin
  5325. Create;
  5326. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  5327. end;
  5328. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5329. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  5330. begin
  5331. Create;
  5332. LoadFromResource(aInstance, aResource, aResType);
  5333. end;
  5334. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5335. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5336. begin
  5337. Create;
  5338. LoadFromResourceID(aInstance, aResourceID, aResType);
  5339. end;
  5340. {$IFDEF GLB_SUPPORT_PNG_READ}
  5341. {$IF DEFINED(GLB_LAZ_PNG)}
  5342. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5343. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5344. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5345. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5346. const
  5347. MAGIC_LEN = 8;
  5348. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  5349. var
  5350. reader: TLazReaderPNG;
  5351. intf: TLazIntfImage;
  5352. StreamPos: Int64;
  5353. magic: String[MAGIC_LEN];
  5354. begin
  5355. result := true;
  5356. StreamPos := aStream.Position;
  5357. SetLength(magic, MAGIC_LEN);
  5358. aStream.Read(magic[1], MAGIC_LEN);
  5359. aStream.Position := StreamPos;
  5360. if (magic <> PNG_MAGIC) then begin
  5361. result := false;
  5362. exit;
  5363. end;
  5364. intf := TLazIntfImage.Create(0, 0);
  5365. reader := TLazReaderPNG.Create;
  5366. try try
  5367. reader.UpdateDescription := true;
  5368. reader.ImageRead(aStream, intf);
  5369. AssignFromLazIntfImage(intf);
  5370. except
  5371. result := false;
  5372. aStream.Position := StreamPos;
  5373. exit;
  5374. end;
  5375. finally
  5376. reader.Free;
  5377. intf.Free;
  5378. end;
  5379. end;
  5380. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5381. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5382. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5383. var
  5384. Surface: PSDL_Surface;
  5385. RWops: PSDL_RWops;
  5386. begin
  5387. result := false;
  5388. RWops := glBitmapCreateRWops(aStream);
  5389. try
  5390. if IMG_isPNG(RWops) > 0 then begin
  5391. Surface := IMG_LoadPNG_RW(RWops);
  5392. try
  5393. AssignFromSurface(Surface);
  5394. result := true;
  5395. finally
  5396. SDL_FreeSurface(Surface);
  5397. end;
  5398. end;
  5399. finally
  5400. SDL_FreeRW(RWops);
  5401. end;
  5402. end;
  5403. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5404. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5405. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5406. begin
  5407. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5408. end;
  5409. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5410. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5411. var
  5412. StreamPos: Int64;
  5413. signature: array [0..7] of byte;
  5414. png: png_structp;
  5415. png_info: png_infop;
  5416. TempHeight, TempWidth: Integer;
  5417. Format: TglBitmapFormat;
  5418. png_data: pByte;
  5419. png_rows: array of pByte;
  5420. Row, LineSize: Integer;
  5421. begin
  5422. result := false;
  5423. if not init_libPNG then
  5424. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5425. try
  5426. // signature
  5427. StreamPos := aStream.Position;
  5428. aStream.Read(signature{%H-}, 8);
  5429. aStream.Position := StreamPos;
  5430. if png_check_sig(@signature, 8) <> 0 then begin
  5431. // png read struct
  5432. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5433. if png = nil then
  5434. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5435. // png info
  5436. png_info := png_create_info_struct(png);
  5437. if png_info = nil then begin
  5438. png_destroy_read_struct(@png, nil, nil);
  5439. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5440. end;
  5441. // set read callback
  5442. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5443. // read informations
  5444. png_read_info(png, png_info);
  5445. // size
  5446. TempHeight := png_get_image_height(png, png_info);
  5447. TempWidth := png_get_image_width(png, png_info);
  5448. // format
  5449. case png_get_color_type(png, png_info) of
  5450. PNG_COLOR_TYPE_GRAY:
  5451. Format := tfLuminance8ub1;
  5452. PNG_COLOR_TYPE_GRAY_ALPHA:
  5453. Format := tfLuminance8Alpha8us1;
  5454. PNG_COLOR_TYPE_RGB:
  5455. Format := tfRGB8ub3;
  5456. PNG_COLOR_TYPE_RGB_ALPHA:
  5457. Format := tfRGBA8ub4;
  5458. else
  5459. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5460. end;
  5461. // cut upper 8 bit from 16 bit formats
  5462. if png_get_bit_depth(png, png_info) > 8 then
  5463. png_set_strip_16(png);
  5464. // expand bitdepth smaller than 8
  5465. if png_get_bit_depth(png, png_info) < 8 then
  5466. png_set_expand(png);
  5467. // allocating mem for scanlines
  5468. LineSize := png_get_rowbytes(png, png_info);
  5469. GetMem(png_data, TempHeight * LineSize);
  5470. try
  5471. SetLength(png_rows, TempHeight);
  5472. for Row := Low(png_rows) to High(png_rows) do begin
  5473. png_rows[Row] := png_data;
  5474. Inc(png_rows[Row], Row * LineSize);
  5475. end;
  5476. // read complete image into scanlines
  5477. png_read_image(png, @png_rows[0]);
  5478. // read end
  5479. png_read_end(png, png_info);
  5480. // destroy read struct
  5481. png_destroy_read_struct(@png, @png_info, nil);
  5482. SetLength(png_rows, 0);
  5483. // set new data
  5484. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5485. result := true;
  5486. except
  5487. if Assigned(png_data) then
  5488. FreeMem(png_data);
  5489. raise;
  5490. end;
  5491. end;
  5492. finally
  5493. quit_libPNG;
  5494. end;
  5495. end;
  5496. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5497. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5498. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5499. var
  5500. StreamPos: Int64;
  5501. Png: TPNGObject;
  5502. Header: String[8];
  5503. Row, Col, PixSize, LineSize: Integer;
  5504. NewImage, pSource, pDest, pAlpha: pByte;
  5505. PngFormat: TglBitmapFormat;
  5506. FormatDesc: TFormatDescriptor;
  5507. const
  5508. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5509. begin
  5510. result := false;
  5511. StreamPos := aStream.Position;
  5512. aStream.Read(Header[0], SizeOf(Header));
  5513. aStream.Position := StreamPos;
  5514. {Test if the header matches}
  5515. if Header = PngHeader then begin
  5516. Png := TPNGObject.Create;
  5517. try
  5518. Png.LoadFromStream(aStream);
  5519. case Png.Header.ColorType of
  5520. COLOR_GRAYSCALE:
  5521. PngFormat := tfLuminance8ub1;
  5522. COLOR_GRAYSCALEALPHA:
  5523. PngFormat := tfLuminance8Alpha8us1;
  5524. COLOR_RGB:
  5525. PngFormat := tfBGR8ub3;
  5526. COLOR_RGBALPHA:
  5527. PngFormat := tfBGRA8ub4;
  5528. else
  5529. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5530. end;
  5531. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5532. PixSize := Round(FormatDesc.PixelSize);
  5533. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5534. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5535. try
  5536. pDest := NewImage;
  5537. case Png.Header.ColorType of
  5538. COLOR_RGB, COLOR_GRAYSCALE:
  5539. begin
  5540. for Row := 0 to Png.Height -1 do begin
  5541. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5542. Inc(pDest, LineSize);
  5543. end;
  5544. end;
  5545. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5546. begin
  5547. PixSize := PixSize -1;
  5548. for Row := 0 to Png.Height -1 do begin
  5549. pSource := Png.Scanline[Row];
  5550. pAlpha := pByte(Png.AlphaScanline[Row]);
  5551. for Col := 0 to Png.Width -1 do begin
  5552. Move (pSource^, pDest^, PixSize);
  5553. Inc(pSource, PixSize);
  5554. Inc(pDest, PixSize);
  5555. pDest^ := pAlpha^;
  5556. inc(pAlpha);
  5557. Inc(pDest);
  5558. end;
  5559. end;
  5560. end;
  5561. else
  5562. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5563. end;
  5564. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5565. result := true;
  5566. except
  5567. if Assigned(NewImage) then
  5568. FreeMem(NewImage);
  5569. raise;
  5570. end;
  5571. finally
  5572. Png.Free;
  5573. end;
  5574. end;
  5575. end;
  5576. {$IFEND}
  5577. {$ENDIF}
  5578. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5579. {$IFDEF GLB_LIB_PNG}
  5580. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5581. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5582. begin
  5583. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5584. end;
  5585. {$ENDIF}
  5586. {$IF DEFINED(GLB_LAZ_PNG)}
  5587. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5588. procedure TglBitmap.SavePNG(const aStream: TStream);
  5589. var
  5590. png: TPortableNetworkGraphic;
  5591. intf: TLazIntfImage;
  5592. raw: TRawImage;
  5593. begin
  5594. png := TPortableNetworkGraphic.Create;
  5595. intf := TLazIntfImage.Create(0, 0);
  5596. try
  5597. if not AssignToLazIntfImage(intf) then
  5598. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5599. intf.GetRawImage(raw);
  5600. png.LoadFromRawImage(raw, false);
  5601. png.SaveToStream(aStream);
  5602. finally
  5603. png.Free;
  5604. intf.Free;
  5605. end;
  5606. end;
  5607. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5608. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5609. procedure TglBitmap.SavePNG(const aStream: TStream);
  5610. var
  5611. png: png_structp;
  5612. png_info: png_infop;
  5613. png_rows: array of pByte;
  5614. LineSize: Integer;
  5615. ColorType: Integer;
  5616. Row: Integer;
  5617. FormatDesc: TFormatDescriptor;
  5618. begin
  5619. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5620. raise EglBitmapUnsupportedFormat.Create(Format);
  5621. if not init_libPNG then
  5622. raise Exception.Create('unable to initialize libPNG.');
  5623. try
  5624. case Format of
  5625. tfAlpha8ub1, tfLuminance8ub1:
  5626. ColorType := PNG_COLOR_TYPE_GRAY;
  5627. tfLuminance8Alpha8us1:
  5628. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5629. tfBGR8ub3, tfRGB8ub3:
  5630. ColorType := PNG_COLOR_TYPE_RGB;
  5631. tfBGRA8ub4, tfRGBA8ub4:
  5632. ColorType := PNG_COLOR_TYPE_RGBA;
  5633. else
  5634. raise EglBitmapUnsupportedFormat.Create(Format);
  5635. end;
  5636. FormatDesc := TFormatDescriptor.Get(Format);
  5637. LineSize := FormatDesc.GetSize(Width, 1);
  5638. // creating array for scanline
  5639. SetLength(png_rows, Height);
  5640. try
  5641. for Row := 0 to Height - 1 do begin
  5642. png_rows[Row] := Data;
  5643. Inc(png_rows[Row], Row * LineSize)
  5644. end;
  5645. // write struct
  5646. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5647. if png = nil then
  5648. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5649. // create png info
  5650. png_info := png_create_info_struct(png);
  5651. if png_info = nil then begin
  5652. png_destroy_write_struct(@png, nil);
  5653. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5654. end;
  5655. // set read callback
  5656. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5657. // set compression
  5658. png_set_compression_level(png, 6);
  5659. if Format in [tfBGR8ub3, tfBGRA8ub4] then
  5660. png_set_bgr(png);
  5661. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5662. png_write_info(png, png_info);
  5663. png_write_image(png, @png_rows[0]);
  5664. png_write_end(png, png_info);
  5665. png_destroy_write_struct(@png, @png_info);
  5666. finally
  5667. SetLength(png_rows, 0);
  5668. end;
  5669. finally
  5670. quit_libPNG;
  5671. end;
  5672. end;
  5673. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5674. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5675. procedure TglBitmap.SavePNG(const aStream: TStream);
  5676. var
  5677. Png: TPNGObject;
  5678. pSource, pDest: pByte;
  5679. X, Y, PixSize: Integer;
  5680. ColorType: Cardinal;
  5681. Alpha: Boolean;
  5682. pTemp: pByte;
  5683. Temp: Byte;
  5684. begin
  5685. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5686. raise EglBitmapUnsupportedFormat.Create(Format);
  5687. case Format of
  5688. tfAlpha8ub1, tfLuminance8ub1: begin
  5689. ColorType := COLOR_GRAYSCALE;
  5690. PixSize := 1;
  5691. Alpha := false;
  5692. end;
  5693. tfLuminance8Alpha8us1: begin
  5694. ColorType := COLOR_GRAYSCALEALPHA;
  5695. PixSize := 1;
  5696. Alpha := true;
  5697. end;
  5698. tfBGR8ub3, tfRGB8ub3: begin
  5699. ColorType := COLOR_RGB;
  5700. PixSize := 3;
  5701. Alpha := false;
  5702. end;
  5703. tfBGRA8ub4, tfRGBA8ub4: begin
  5704. ColorType := COLOR_RGBALPHA;
  5705. PixSize := 3;
  5706. Alpha := true
  5707. end;
  5708. else
  5709. raise EglBitmapUnsupportedFormat.Create(Format);
  5710. end;
  5711. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5712. try
  5713. // Copy ImageData
  5714. pSource := Data;
  5715. for Y := 0 to Height -1 do begin
  5716. pDest := png.ScanLine[Y];
  5717. for X := 0 to Width -1 do begin
  5718. Move(pSource^, pDest^, PixSize);
  5719. Inc(pDest, PixSize);
  5720. Inc(pSource, PixSize);
  5721. if Alpha then begin
  5722. png.AlphaScanline[Y]^[X] := pSource^;
  5723. Inc(pSource);
  5724. end;
  5725. end;
  5726. // convert RGB line to BGR
  5727. if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
  5728. pTemp := png.ScanLine[Y];
  5729. for X := 0 to Width -1 do begin
  5730. Temp := pByteArray(pTemp)^[0];
  5731. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5732. pByteArray(pTemp)^[2] := Temp;
  5733. Inc(pTemp, 3);
  5734. end;
  5735. end;
  5736. end;
  5737. // Save to Stream
  5738. Png.CompressionLevel := 6;
  5739. Png.SaveToStream(aStream);
  5740. finally
  5741. FreeAndNil(Png);
  5742. end;
  5743. end;
  5744. {$IFEND}
  5745. {$ENDIF}
  5746. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5747. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5748. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5749. {$IFDEF GLB_LIB_JPEG}
  5750. type
  5751. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5752. glBitmap_libJPEG_source_mgr = record
  5753. pub: jpeg_source_mgr;
  5754. SrcStream: TStream;
  5755. SrcBuffer: array [1..4096] of byte;
  5756. end;
  5757. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5758. glBitmap_libJPEG_dest_mgr = record
  5759. pub: jpeg_destination_mgr;
  5760. DestStream: TStream;
  5761. DestBuffer: array [1..4096] of byte;
  5762. end;
  5763. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5764. begin
  5765. //DUMMY
  5766. end;
  5767. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5768. begin
  5769. //DUMMY
  5770. end;
  5771. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5772. begin
  5773. //DUMMY
  5774. end;
  5775. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5776. begin
  5777. //DUMMY
  5778. end;
  5779. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5780. begin
  5781. //DUMMY
  5782. end;
  5783. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5784. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5785. var
  5786. src: glBitmap_libJPEG_source_mgr_ptr;
  5787. bytes: integer;
  5788. begin
  5789. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5790. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5791. if (bytes <= 0) then begin
  5792. src^.SrcBuffer[1] := $FF;
  5793. src^.SrcBuffer[2] := JPEG_EOI;
  5794. bytes := 2;
  5795. end;
  5796. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5797. src^.pub.bytes_in_buffer := bytes;
  5798. result := true;
  5799. end;
  5800. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5801. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5802. var
  5803. src: glBitmap_libJPEG_source_mgr_ptr;
  5804. begin
  5805. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5806. if num_bytes > 0 then begin
  5807. // wanted byte isn't in buffer so set stream position and read buffer
  5808. if num_bytes > src^.pub.bytes_in_buffer then begin
  5809. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5810. src^.pub.fill_input_buffer(cinfo);
  5811. end else begin
  5812. // wanted byte is in buffer so only skip
  5813. inc(src^.pub.next_input_byte, num_bytes);
  5814. dec(src^.pub.bytes_in_buffer, num_bytes);
  5815. end;
  5816. end;
  5817. end;
  5818. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5819. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5820. var
  5821. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5822. begin
  5823. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5824. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5825. // write complete buffer
  5826. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5827. // reset buffer
  5828. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5829. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5830. end;
  5831. result := true;
  5832. end;
  5833. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5834. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5835. var
  5836. Idx: Integer;
  5837. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5838. begin
  5839. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5840. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5841. // check for endblock
  5842. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5843. // write endblock
  5844. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5845. // leave
  5846. break;
  5847. end else
  5848. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5849. end;
  5850. end;
  5851. {$ENDIF}
  5852. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5853. {$IF DEFINED(GLB_LAZ_JPEG)}
  5854. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5855. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5856. const
  5857. MAGIC_LEN = 2;
  5858. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  5859. var
  5860. intf: TLazIntfImage;
  5861. reader: TFPReaderJPEG;
  5862. StreamPos: Int64;
  5863. magic: String[MAGIC_LEN];
  5864. begin
  5865. result := true;
  5866. StreamPos := aStream.Position;
  5867. SetLength(magic, MAGIC_LEN);
  5868. aStream.Read(magic[1], MAGIC_LEN);
  5869. aStream.Position := StreamPos;
  5870. if (magic <> JPEG_MAGIC) then begin
  5871. result := false;
  5872. exit;
  5873. end;
  5874. reader := TFPReaderJPEG.Create;
  5875. intf := TLazIntfImage.Create(0, 0);
  5876. try try
  5877. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  5878. reader.ImageRead(aStream, intf);
  5879. AssignFromLazIntfImage(intf);
  5880. except
  5881. result := false;
  5882. aStream.Position := StreamPos;
  5883. exit;
  5884. end;
  5885. finally
  5886. reader.Free;
  5887. intf.Free;
  5888. end;
  5889. end;
  5890. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5891. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5892. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5893. var
  5894. Surface: PSDL_Surface;
  5895. RWops: PSDL_RWops;
  5896. begin
  5897. result := false;
  5898. RWops := glBitmapCreateRWops(aStream);
  5899. try
  5900. if IMG_isJPG(RWops) > 0 then begin
  5901. Surface := IMG_LoadJPG_RW(RWops);
  5902. try
  5903. AssignFromSurface(Surface);
  5904. result := true;
  5905. finally
  5906. SDL_FreeSurface(Surface);
  5907. end;
  5908. end;
  5909. finally
  5910. SDL_FreeRW(RWops);
  5911. end;
  5912. end;
  5913. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5914. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5915. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5916. var
  5917. StreamPos: Int64;
  5918. Temp: array[0..1]of Byte;
  5919. jpeg: jpeg_decompress_struct;
  5920. jpeg_err: jpeg_error_mgr;
  5921. IntFormat: TglBitmapFormat;
  5922. pImage: pByte;
  5923. TempHeight, TempWidth: Integer;
  5924. pTemp: pByte;
  5925. Row: Integer;
  5926. FormatDesc: TFormatDescriptor;
  5927. begin
  5928. result := false;
  5929. if not init_libJPEG then
  5930. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5931. try
  5932. // reading first two bytes to test file and set cursor back to begin
  5933. StreamPos := aStream.Position;
  5934. aStream.Read({%H-}Temp[0], 2);
  5935. aStream.Position := StreamPos;
  5936. // if Bitmap then read file.
  5937. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5938. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5939. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5940. // error managment
  5941. jpeg.err := jpeg_std_error(@jpeg_err);
  5942. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5943. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5944. // decompression struct
  5945. jpeg_create_decompress(@jpeg);
  5946. // allocation space for streaming methods
  5947. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5948. // seeting up custom functions
  5949. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5950. pub.init_source := glBitmap_libJPEG_init_source;
  5951. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5952. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5953. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5954. pub.term_source := glBitmap_libJPEG_term_source;
  5955. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5956. pub.next_input_byte := nil; // until buffer loaded
  5957. SrcStream := aStream;
  5958. end;
  5959. // set global decoding state
  5960. jpeg.global_state := DSTATE_START;
  5961. // read header of jpeg
  5962. jpeg_read_header(@jpeg, false);
  5963. // setting output parameter
  5964. case jpeg.jpeg_color_space of
  5965. JCS_GRAYSCALE:
  5966. begin
  5967. jpeg.out_color_space := JCS_GRAYSCALE;
  5968. IntFormat := tfLuminance8ub1;
  5969. end;
  5970. else
  5971. jpeg.out_color_space := JCS_RGB;
  5972. IntFormat := tfRGB8ub3;
  5973. end;
  5974. // reading image
  5975. jpeg_start_decompress(@jpeg);
  5976. TempHeight := jpeg.output_height;
  5977. TempWidth := jpeg.output_width;
  5978. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5979. // creating new image
  5980. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5981. try
  5982. pTemp := pImage;
  5983. for Row := 0 to TempHeight -1 do begin
  5984. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5985. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5986. end;
  5987. // finish decompression
  5988. jpeg_finish_decompress(@jpeg);
  5989. // destroy decompression
  5990. jpeg_destroy_decompress(@jpeg);
  5991. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5992. result := true;
  5993. except
  5994. if Assigned(pImage) then
  5995. FreeMem(pImage);
  5996. raise;
  5997. end;
  5998. end;
  5999. finally
  6000. quit_libJPEG;
  6001. end;
  6002. end;
  6003. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  6004. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6005. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6006. var
  6007. bmp: TBitmap;
  6008. jpg: TJPEGImage;
  6009. StreamPos: Int64;
  6010. Temp: array[0..1]of Byte;
  6011. begin
  6012. result := false;
  6013. // reading first two bytes to test file and set cursor back to begin
  6014. StreamPos := aStream.Position;
  6015. aStream.Read(Temp[0], 2);
  6016. aStream.Position := StreamPos;
  6017. // if Bitmap then read file.
  6018. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  6019. bmp := TBitmap.Create;
  6020. try
  6021. jpg := TJPEGImage.Create;
  6022. try
  6023. jpg.LoadFromStream(aStream);
  6024. bmp.Assign(jpg);
  6025. result := AssignFromBitmap(bmp);
  6026. finally
  6027. jpg.Free;
  6028. end;
  6029. finally
  6030. bmp.Free;
  6031. end;
  6032. end;
  6033. end;
  6034. {$IFEND}
  6035. {$ENDIF}
  6036. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  6037. {$IF DEFINED(GLB_LAZ_JPEG)}
  6038. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6039. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6040. var
  6041. jpeg: TJPEGImage;
  6042. intf: TLazIntfImage;
  6043. raw: TRawImage;
  6044. begin
  6045. jpeg := TJPEGImage.Create;
  6046. intf := TLazIntfImage.Create(0, 0);
  6047. try
  6048. if not AssignToLazIntfImage(intf) then
  6049. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  6050. intf.GetRawImage(raw);
  6051. jpeg.LoadFromRawImage(raw, false);
  6052. jpeg.SaveToStream(aStream);
  6053. finally
  6054. intf.Free;
  6055. jpeg.Free;
  6056. end;
  6057. end;
  6058. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  6059. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6060. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6061. var
  6062. jpeg: jpeg_compress_struct;
  6063. jpeg_err: jpeg_error_mgr;
  6064. Row: Integer;
  6065. pTemp, pTemp2: pByte;
  6066. procedure CopyRow(pDest, pSource: pByte);
  6067. var
  6068. X: Integer;
  6069. begin
  6070. for X := 0 to Width - 1 do begin
  6071. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  6072. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  6073. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  6074. Inc(pDest, 3);
  6075. Inc(pSource, 3);
  6076. end;
  6077. end;
  6078. begin
  6079. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6080. raise EglBitmapUnsupportedFormat.Create(Format);
  6081. if not init_libJPEG then
  6082. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  6083. try
  6084. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  6085. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  6086. // error managment
  6087. jpeg.err := jpeg_std_error(@jpeg_err);
  6088. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  6089. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  6090. // compression struct
  6091. jpeg_create_compress(@jpeg);
  6092. // allocation space for streaming methods
  6093. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  6094. // seeting up custom functions
  6095. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  6096. pub.init_destination := glBitmap_libJPEG_init_destination;
  6097. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  6098. pub.term_destination := glBitmap_libJPEG_term_destination;
  6099. pub.next_output_byte := @DestBuffer[1];
  6100. pub.free_in_buffer := Length(DestBuffer);
  6101. DestStream := aStream;
  6102. end;
  6103. // very important state
  6104. jpeg.global_state := CSTATE_START;
  6105. jpeg.image_width := Width;
  6106. jpeg.image_height := Height;
  6107. case Format of
  6108. tfAlpha8ub1, tfLuminance8ub1: begin
  6109. jpeg.input_components := 1;
  6110. jpeg.in_color_space := JCS_GRAYSCALE;
  6111. end;
  6112. tfRGB8ub3, tfBGR8ub3: begin
  6113. jpeg.input_components := 3;
  6114. jpeg.in_color_space := JCS_RGB;
  6115. end;
  6116. end;
  6117. jpeg_set_defaults(@jpeg);
  6118. jpeg_set_quality(@jpeg, 95, true);
  6119. jpeg_start_compress(@jpeg, true);
  6120. pTemp := Data;
  6121. if Format = tfBGR8ub3 then
  6122. GetMem(pTemp2, fRowSize)
  6123. else
  6124. pTemp2 := pTemp;
  6125. try
  6126. for Row := 0 to jpeg.image_height -1 do begin
  6127. // prepare row
  6128. if Format = tfBGR8ub3 then
  6129. CopyRow(pTemp2, pTemp)
  6130. else
  6131. pTemp2 := pTemp;
  6132. // write row
  6133. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  6134. inc(pTemp, fRowSize);
  6135. end;
  6136. finally
  6137. // free memory
  6138. if Format = tfBGR8ub3 then
  6139. FreeMem(pTemp2);
  6140. end;
  6141. jpeg_finish_compress(@jpeg);
  6142. jpeg_destroy_compress(@jpeg);
  6143. finally
  6144. quit_libJPEG;
  6145. end;
  6146. end;
  6147. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  6148. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6149. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6150. var
  6151. Bmp: TBitmap;
  6152. Jpg: TJPEGImage;
  6153. begin
  6154. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6155. raise EglBitmapUnsupportedFormat.Create(Format);
  6156. Bmp := TBitmap.Create;
  6157. try
  6158. Jpg := TJPEGImage.Create;
  6159. try
  6160. AssignToBitmap(Bmp);
  6161. if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
  6162. Jpg.Grayscale := true;
  6163. Jpg.PixelFormat := jf8Bit;
  6164. end;
  6165. Jpg.Assign(Bmp);
  6166. Jpg.SaveToStream(aStream);
  6167. finally
  6168. FreeAndNil(Jpg);
  6169. end;
  6170. finally
  6171. FreeAndNil(Bmp);
  6172. end;
  6173. end;
  6174. {$IFEND}
  6175. {$ENDIF}
  6176. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6177. //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6178. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6179. type
  6180. RawHeader = packed record
  6181. Magic: String[5];
  6182. Version: Byte;
  6183. Width: Integer;
  6184. Height: Integer;
  6185. DataSize: Integer;
  6186. BitsPerPixel: Integer;
  6187. Precision: TglBitmapRec4ub;
  6188. Shift: TglBitmapRec4ub;
  6189. end;
  6190. function TglBitmap.LoadRAW(const aStream: TStream): Boolean;
  6191. var
  6192. header: RawHeader;
  6193. StartPos: Int64;
  6194. fd: TFormatDescriptor;
  6195. buf: PByte;
  6196. begin
  6197. result := false;
  6198. StartPos := aStream.Position;
  6199. aStream.Read(header{%H-}, SizeOf(header));
  6200. if (header.Magic <> 'glBMP') then begin
  6201. aStream.Position := StartPos;
  6202. exit;
  6203. end;
  6204. fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
  6205. if (fd.Format = tfEmpty) then
  6206. raise EglBitmapUnsupportedFormat.Create('no supported format found');
  6207. buf := GetMemory(header.DataSize);
  6208. aStream.Read(buf^, header.DataSize);
  6209. SetDataPointer(buf, fd.Format, header.Width, header.Height);
  6210. result := true;
  6211. end;
  6212. procedure TglBitmap.SaveRAW(const aStream: TStream);
  6213. var
  6214. header: RawHeader;
  6215. fd: TFormatDescriptor;
  6216. begin
  6217. fd := TFormatDescriptor.Get(Format);
  6218. header.Magic := 'glBMP';
  6219. header.Version := 1;
  6220. header.Width := Width;
  6221. header.Height := Height;
  6222. header.DataSize := fd.GetSize(fDimension);
  6223. header.BitsPerPixel := fd.BitsPerPixel;
  6224. header.Precision := fd.Precision;
  6225. header.Shift := fd.Shift;
  6226. aStream.Write(header, SizeOf(header));
  6227. aStream.Write(Data^, header.DataSize);
  6228. end;
  6229. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6230. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6231. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6232. const
  6233. BMP_MAGIC = $4D42;
  6234. BMP_COMP_RGB = 0;
  6235. BMP_COMP_RLE8 = 1;
  6236. BMP_COMP_RLE4 = 2;
  6237. BMP_COMP_BITFIELDS = 3;
  6238. type
  6239. TBMPHeader = packed record
  6240. bfType: Word;
  6241. bfSize: Cardinal;
  6242. bfReserved1: Word;
  6243. bfReserved2: Word;
  6244. bfOffBits: Cardinal;
  6245. end;
  6246. TBMPInfo = packed record
  6247. biSize: Cardinal;
  6248. biWidth: Longint;
  6249. biHeight: Longint;
  6250. biPlanes: Word;
  6251. biBitCount: Word;
  6252. biCompression: Cardinal;
  6253. biSizeImage: Cardinal;
  6254. biXPelsPerMeter: Longint;
  6255. biYPelsPerMeter: Longint;
  6256. biClrUsed: Cardinal;
  6257. biClrImportant: Cardinal;
  6258. end;
  6259. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6260. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  6261. //////////////////////////////////////////////////////////////////////////////////////////////////
  6262. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
  6263. begin
  6264. result := tfEmpty;
  6265. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  6266. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  6267. //Read Compression
  6268. case aInfo.biCompression of
  6269. BMP_COMP_RLE4,
  6270. BMP_COMP_RLE8: begin
  6271. raise EglBitmap.Create('RLE compression is not supported');
  6272. end;
  6273. BMP_COMP_BITFIELDS: begin
  6274. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  6275. aStream.Read(aMask.r, SizeOf(aMask.r));
  6276. aStream.Read(aMask.g, SizeOf(aMask.g));
  6277. aStream.Read(aMask.b, SizeOf(aMask.b));
  6278. aStream.Read(aMask.a, SizeOf(aMask.a));
  6279. end else
  6280. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  6281. end;
  6282. end;
  6283. //get suitable format
  6284. case aInfo.biBitCount of
  6285. 8: result := tfLuminance8ub1;
  6286. 16: result := tfX1RGB5us1;
  6287. 24: result := tfBGR8ub3;
  6288. 32: result := tfXRGB8ui1;
  6289. end;
  6290. end;
  6291. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  6292. var
  6293. i, c: Integer;
  6294. ColorTable: TbmpColorTable;
  6295. begin
  6296. result := nil;
  6297. if (aInfo.biBitCount >= 16) then
  6298. exit;
  6299. aFormat := tfLuminance8ub1;
  6300. c := aInfo.biClrUsed;
  6301. if (c = 0) then
  6302. c := 1 shl aInfo.biBitCount;
  6303. SetLength(ColorTable, c);
  6304. for i := 0 to c-1 do begin
  6305. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  6306. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  6307. aFormat := tfRGB8ub3;
  6308. end;
  6309. result := TbmpColorTableFormat.Create;
  6310. result.BitsPerPixel := aInfo.biBitCount;
  6311. result.ColorTable := ColorTable;
  6312. result.CalcValues;
  6313. end;
  6314. //////////////////////////////////////////////////////////////////////////////////////////////////
  6315. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
  6316. var
  6317. FormatDesc: TFormatDescriptor;
  6318. begin
  6319. result := nil;
  6320. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  6321. FormatDesc := TFormatDescriptor.GetFromMask(aMask);
  6322. if (FormatDesc.Format = tfEmpty) then
  6323. exit;
  6324. aFormat := FormatDesc.Format;
  6325. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  6326. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  6327. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  6328. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  6329. result := TbmpBitfieldFormat.Create;
  6330. result.SetCustomValues(aInfo.biBitCount, aMask);
  6331. end;
  6332. end;
  6333. var
  6334. //simple types
  6335. StartPos: Int64;
  6336. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  6337. PaddingBuff: Cardinal;
  6338. LineBuf, ImageData, TmpData: PByte;
  6339. SourceMD, DestMD: Pointer;
  6340. BmpFormat: TglBitmapFormat;
  6341. //records
  6342. Mask: TglBitmapRec4ul;
  6343. Header: TBMPHeader;
  6344. Info: TBMPInfo;
  6345. //classes
  6346. SpecialFormat: TFormatDescriptor;
  6347. FormatDesc: TFormatDescriptor;
  6348. //////////////////////////////////////////////////////////////////////////////////////////////////
  6349. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  6350. var
  6351. i: Integer;
  6352. Pixel: TglBitmapPixelData;
  6353. begin
  6354. aStream.Read(aLineBuf^, rbLineSize);
  6355. SpecialFormat.PreparePixel(Pixel);
  6356. for i := 0 to Info.biWidth-1 do begin
  6357. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  6358. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  6359. FormatDesc.Map(Pixel, aData, DestMD);
  6360. end;
  6361. end;
  6362. begin
  6363. result := false;
  6364. BmpFormat := tfEmpty;
  6365. SpecialFormat := nil;
  6366. LineBuf := nil;
  6367. SourceMD := nil;
  6368. DestMD := nil;
  6369. // Header
  6370. StartPos := aStream.Position;
  6371. aStream.Read(Header{%H-}, SizeOf(Header));
  6372. if Header.bfType = BMP_MAGIC then begin
  6373. try try
  6374. BmpFormat := ReadInfo(Info, Mask);
  6375. SpecialFormat := ReadColorTable(BmpFormat, Info);
  6376. if not Assigned(SpecialFormat) then
  6377. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  6378. aStream.Position := StartPos + Header.bfOffBits;
  6379. if (BmpFormat <> tfEmpty) then begin
  6380. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  6381. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  6382. wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
  6383. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  6384. //get Memory
  6385. DestMD := FormatDesc.CreateMappingData;
  6386. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  6387. GetMem(ImageData, ImageSize);
  6388. if Assigned(SpecialFormat) then begin
  6389. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  6390. SourceMD := SpecialFormat.CreateMappingData;
  6391. end;
  6392. //read Data
  6393. try try
  6394. FillChar(ImageData^, ImageSize, $FF);
  6395. TmpData := ImageData;
  6396. if (Info.biHeight > 0) then
  6397. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  6398. for i := 0 to Abs(Info.biHeight)-1 do begin
  6399. if Assigned(SpecialFormat) then
  6400. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  6401. else
  6402. aStream.Read(TmpData^, wbLineSize); //else only read data
  6403. if (Info.biHeight > 0) then
  6404. dec(TmpData, wbLineSize)
  6405. else
  6406. inc(TmpData, wbLineSize);
  6407. aStream.Read(PaddingBuff{%H-}, Padding);
  6408. end;
  6409. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6410. result := true;
  6411. finally
  6412. if Assigned(LineBuf) then
  6413. FreeMem(LineBuf);
  6414. if Assigned(SourceMD) then
  6415. SpecialFormat.FreeMappingData(SourceMD);
  6416. FormatDesc.FreeMappingData(DestMD);
  6417. end;
  6418. except
  6419. if Assigned(ImageData) then
  6420. FreeMem(ImageData);
  6421. raise;
  6422. end;
  6423. end else
  6424. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6425. except
  6426. aStream.Position := StartPos;
  6427. raise;
  6428. end;
  6429. finally
  6430. FreeAndNil(SpecialFormat);
  6431. end;
  6432. end
  6433. else aStream.Position := StartPos;
  6434. end;
  6435. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6436. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6437. var
  6438. Header: TBMPHeader;
  6439. Info: TBMPInfo;
  6440. Converter: TFormatDescriptor;
  6441. FormatDesc: TFormatDescriptor;
  6442. SourceFD, DestFD: Pointer;
  6443. pData, srcData, dstData, ConvertBuffer: pByte;
  6444. Pixel: TglBitmapPixelData;
  6445. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6446. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6447. PaddingBuff: Cardinal;
  6448. function GetLineWidth : Integer;
  6449. begin
  6450. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6451. end;
  6452. begin
  6453. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6454. raise EglBitmapUnsupportedFormat.Create(Format);
  6455. Converter := nil;
  6456. FormatDesc := TFormatDescriptor.Get(Format);
  6457. ImageSize := FormatDesc.GetSize(Dimension);
  6458. FillChar(Header{%H-}, SizeOf(Header), 0);
  6459. Header.bfType := BMP_MAGIC;
  6460. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6461. Header.bfReserved1 := 0;
  6462. Header.bfReserved2 := 0;
  6463. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6464. FillChar(Info{%H-}, SizeOf(Info), 0);
  6465. Info.biSize := SizeOf(Info);
  6466. Info.biWidth := Width;
  6467. Info.biHeight := Height;
  6468. Info.biPlanes := 1;
  6469. Info.biCompression := BMP_COMP_RGB;
  6470. Info.biSizeImage := ImageSize;
  6471. try
  6472. case Format of
  6473. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
  6474. begin
  6475. Info.biBitCount := 8;
  6476. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6477. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6478. Converter := TbmpColorTableFormat.Create;
  6479. with (Converter as TbmpColorTableFormat) do begin
  6480. SetCustomValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift);
  6481. CreateColorTable;
  6482. end;
  6483. end;
  6484. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  6485. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  6486. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
  6487. begin
  6488. Info.biBitCount := 16;
  6489. Info.biCompression := BMP_COMP_BITFIELDS;
  6490. end;
  6491. tfBGR8ub3, tfRGB8ub3:
  6492. begin
  6493. Info.biBitCount := 24;
  6494. if (Format = tfRGB8ub3) then
  6495. Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6496. end;
  6497. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  6498. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
  6499. begin
  6500. Info.biBitCount := 32;
  6501. Info.biCompression := BMP_COMP_BITFIELDS;
  6502. end;
  6503. else
  6504. raise EglBitmapUnsupportedFormat.Create(Format);
  6505. end;
  6506. Info.biXPelsPerMeter := 2835;
  6507. Info.biYPelsPerMeter := 2835;
  6508. // prepare bitmasks
  6509. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6510. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6511. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6512. RedMask := FormatDesc.Mask.r;
  6513. GreenMask := FormatDesc.Mask.g;
  6514. BlueMask := FormatDesc.Mask.b;
  6515. AlphaMask := FormatDesc.Mask.a;
  6516. end;
  6517. // headers
  6518. aStream.Write(Header, SizeOf(Header));
  6519. aStream.Write(Info, SizeOf(Info));
  6520. // colortable
  6521. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6522. with (Converter as TbmpColorTableFormat) do
  6523. aStream.Write(ColorTable[0].b,
  6524. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6525. // bitmasks
  6526. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6527. aStream.Write(RedMask, SizeOf(Cardinal));
  6528. aStream.Write(GreenMask, SizeOf(Cardinal));
  6529. aStream.Write(BlueMask, SizeOf(Cardinal));
  6530. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6531. end;
  6532. // image data
  6533. rbLineSize := Round(Info.biWidth * FormatDesc.BytesPerPixel);
  6534. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6535. Padding := GetLineWidth - wbLineSize;
  6536. PaddingBuff := 0;
  6537. pData := Data;
  6538. inc(pData, (Height-1) * rbLineSize);
  6539. // prepare row buffer. But only for RGB because RGBA supports color masks
  6540. // so it's possible to change color within the image.
  6541. if Assigned(Converter) then begin
  6542. FormatDesc.PreparePixel(Pixel);
  6543. GetMem(ConvertBuffer, wbLineSize);
  6544. SourceFD := FormatDesc.CreateMappingData;
  6545. DestFD := Converter.CreateMappingData;
  6546. end else
  6547. ConvertBuffer := nil;
  6548. try
  6549. for LineIdx := 0 to Height - 1 do begin
  6550. // preparing row
  6551. if Assigned(Converter) then begin
  6552. srcData := pData;
  6553. dstData := ConvertBuffer;
  6554. for PixelIdx := 0 to Info.biWidth-1 do begin
  6555. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6556. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6557. Converter.Map(Pixel, dstData, DestFD);
  6558. end;
  6559. aStream.Write(ConvertBuffer^, wbLineSize);
  6560. end else begin
  6561. aStream.Write(pData^, rbLineSize);
  6562. end;
  6563. dec(pData, rbLineSize);
  6564. if (Padding > 0) then
  6565. aStream.Write(PaddingBuff, Padding);
  6566. end;
  6567. finally
  6568. // destroy row buffer
  6569. if Assigned(ConvertBuffer) then begin
  6570. FormatDesc.FreeMappingData(SourceFD);
  6571. Converter.FreeMappingData(DestFD);
  6572. FreeMem(ConvertBuffer);
  6573. end;
  6574. end;
  6575. finally
  6576. if Assigned(Converter) then
  6577. Converter.Free;
  6578. end;
  6579. end;
  6580. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6581. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6582. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6583. type
  6584. TTGAHeader = packed record
  6585. ImageID: Byte;
  6586. ColorMapType: Byte;
  6587. ImageType: Byte;
  6588. //ColorMapSpec: Array[0..4] of Byte;
  6589. ColorMapStart: Word;
  6590. ColorMapLength: Word;
  6591. ColorMapEntrySize: Byte;
  6592. OrigX: Word;
  6593. OrigY: Word;
  6594. Width: Word;
  6595. Height: Word;
  6596. Bpp: Byte;
  6597. ImageDesc: Byte;
  6598. end;
  6599. const
  6600. TGA_UNCOMPRESSED_RGB = 2;
  6601. TGA_UNCOMPRESSED_GRAY = 3;
  6602. TGA_COMPRESSED_RGB = 10;
  6603. TGA_COMPRESSED_GRAY = 11;
  6604. TGA_NONE_COLOR_TABLE = 0;
  6605. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6606. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6607. var
  6608. Header: TTGAHeader;
  6609. ImageData: System.PByte;
  6610. StartPosition: Int64;
  6611. PixelSize, LineSize: Integer;
  6612. tgaFormat: TglBitmapFormat;
  6613. FormatDesc: TFormatDescriptor;
  6614. Counter: packed record
  6615. X, Y: packed record
  6616. low, high, dir: Integer;
  6617. end;
  6618. end;
  6619. const
  6620. CACHE_SIZE = $4000;
  6621. ////////////////////////////////////////////////////////////////////////////////////////
  6622. procedure ReadUncompressed;
  6623. var
  6624. i, j: Integer;
  6625. buf, tmp1, tmp2: System.PByte;
  6626. begin
  6627. buf := nil;
  6628. if (Counter.X.dir < 0) then
  6629. GetMem(buf, LineSize);
  6630. try
  6631. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6632. tmp1 := ImageData;
  6633. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6634. if (Counter.X.dir < 0) then begin //flip X
  6635. aStream.Read(buf^, LineSize);
  6636. tmp2 := buf;
  6637. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6638. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6639. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6640. tmp1^ := tmp2^;
  6641. inc(tmp1);
  6642. inc(tmp2);
  6643. end;
  6644. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6645. end;
  6646. end else
  6647. aStream.Read(tmp1^, LineSize);
  6648. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6649. end;
  6650. finally
  6651. if Assigned(buf) then
  6652. FreeMem(buf);
  6653. end;
  6654. end;
  6655. ////////////////////////////////////////////////////////////////////////////////////////
  6656. procedure ReadCompressed;
  6657. /////////////////////////////////////////////////////////////////
  6658. var
  6659. TmpData: System.PByte;
  6660. LinePixelsRead: Integer;
  6661. procedure CheckLine;
  6662. begin
  6663. if (LinePixelsRead >= Header.Width) then begin
  6664. LinePixelsRead := 0;
  6665. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6666. TmpData := ImageData;
  6667. inc(TmpData, Counter.Y.low * LineSize); //set line
  6668. if (Counter.X.dir < 0) then //if x flipped then
  6669. inc(TmpData, LineSize - PixelSize); //set last pixel
  6670. end;
  6671. end;
  6672. /////////////////////////////////////////////////////////////////
  6673. var
  6674. Cache: PByte;
  6675. CacheSize, CachePos: Integer;
  6676. procedure CachedRead(out Buffer; Count: Integer);
  6677. var
  6678. BytesRead: Integer;
  6679. begin
  6680. if (CachePos + Count > CacheSize) then begin
  6681. //if buffer overflow save non read bytes
  6682. BytesRead := 0;
  6683. if (CacheSize - CachePos > 0) then begin
  6684. BytesRead := CacheSize - CachePos;
  6685. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6686. inc(CachePos, BytesRead);
  6687. end;
  6688. //load cache from file
  6689. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6690. aStream.Read(Cache^, CacheSize);
  6691. CachePos := 0;
  6692. //read rest of requested bytes
  6693. if (Count - BytesRead > 0) then begin
  6694. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6695. inc(CachePos, Count - BytesRead);
  6696. end;
  6697. end else begin
  6698. //if no buffer overflow just read the data
  6699. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6700. inc(CachePos, Count);
  6701. end;
  6702. end;
  6703. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6704. begin
  6705. case PixelSize of
  6706. 1: begin
  6707. aBuffer^ := aData^;
  6708. inc(aBuffer, Counter.X.dir);
  6709. end;
  6710. 2: begin
  6711. PWord(aBuffer)^ := PWord(aData)^;
  6712. inc(aBuffer, 2 * Counter.X.dir);
  6713. end;
  6714. 3: begin
  6715. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6716. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6717. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6718. inc(aBuffer, 3 * Counter.X.dir);
  6719. end;
  6720. 4: begin
  6721. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6722. inc(aBuffer, 4 * Counter.X.dir);
  6723. end;
  6724. end;
  6725. end;
  6726. var
  6727. TotalPixelsToRead, TotalPixelsRead: Integer;
  6728. Temp: Byte;
  6729. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6730. PixelRepeat: Boolean;
  6731. PixelsToRead, PixelCount: Integer;
  6732. begin
  6733. CacheSize := 0;
  6734. CachePos := 0;
  6735. TotalPixelsToRead := Header.Width * Header.Height;
  6736. TotalPixelsRead := 0;
  6737. LinePixelsRead := 0;
  6738. GetMem(Cache, CACHE_SIZE);
  6739. try
  6740. TmpData := ImageData;
  6741. inc(TmpData, Counter.Y.low * LineSize); //set line
  6742. if (Counter.X.dir < 0) then //if x flipped then
  6743. inc(TmpData, LineSize - PixelSize); //set last pixel
  6744. repeat
  6745. //read CommandByte
  6746. CachedRead(Temp, 1);
  6747. PixelRepeat := (Temp and $80) > 0;
  6748. PixelsToRead := (Temp and $7F) + 1;
  6749. inc(TotalPixelsRead, PixelsToRead);
  6750. if PixelRepeat then
  6751. CachedRead(buf[0], PixelSize);
  6752. while (PixelsToRead > 0) do begin
  6753. CheckLine;
  6754. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6755. while (PixelCount > 0) do begin
  6756. if not PixelRepeat then
  6757. CachedRead(buf[0], PixelSize);
  6758. PixelToBuffer(@buf[0], TmpData);
  6759. inc(LinePixelsRead);
  6760. dec(PixelsToRead);
  6761. dec(PixelCount);
  6762. end;
  6763. end;
  6764. until (TotalPixelsRead >= TotalPixelsToRead);
  6765. finally
  6766. FreeMem(Cache);
  6767. end;
  6768. end;
  6769. function IsGrayFormat: Boolean;
  6770. begin
  6771. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6772. end;
  6773. begin
  6774. result := false;
  6775. // reading header to test file and set cursor back to begin
  6776. StartPosition := aStream.Position;
  6777. aStream.Read(Header{%H-}, SizeOf(Header));
  6778. // no colormapped files
  6779. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6780. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6781. begin
  6782. try
  6783. if Header.ImageID <> 0 then // skip image ID
  6784. aStream.Position := aStream.Position + Header.ImageID;
  6785. tgaFormat := tfEmpty;
  6786. case Header.Bpp of
  6787. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6788. 0: tgaFormat := tfLuminance8ub1;
  6789. 8: tgaFormat := tfAlpha8ub1;
  6790. end;
  6791. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6792. 0: tgaFormat := tfLuminance16us1;
  6793. 8: tgaFormat := tfLuminance8Alpha8ub2;
  6794. end else case (Header.ImageDesc and $F) of
  6795. 0: tgaFormat := tfX1RGB5us1;
  6796. 1: tgaFormat := tfA1RGB5us1;
  6797. 4: tgaFormat := tfARGB4us1;
  6798. end;
  6799. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6800. 0: tgaFormat := tfBGR8ub3;
  6801. end;
  6802. 32: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6803. 0: tgaFormat := tfDepth32ui1;
  6804. end else case (Header.ImageDesc and $F) of
  6805. 0: tgaFormat := tfX2RGB10ui1;
  6806. 2: tgaFormat := tfA2RGB10ui1;
  6807. 8: tgaFormat := tfARGB8ui1;
  6808. end;
  6809. end;
  6810. if (tgaFormat = tfEmpty) then
  6811. raise EglBitmap.Create('LoadTga - unsupported format');
  6812. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6813. PixelSize := FormatDesc.GetSize(1, 1);
  6814. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6815. GetMem(ImageData, LineSize * Header.Height);
  6816. try
  6817. //column direction
  6818. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6819. Counter.X.low := Header.Height-1;;
  6820. Counter.X.high := 0;
  6821. Counter.X.dir := -1;
  6822. end else begin
  6823. Counter.X.low := 0;
  6824. Counter.X.high := Header.Height-1;
  6825. Counter.X.dir := 1;
  6826. end;
  6827. // Row direction
  6828. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6829. Counter.Y.low := 0;
  6830. Counter.Y.high := Header.Height-1;
  6831. Counter.Y.dir := 1;
  6832. end else begin
  6833. Counter.Y.low := Header.Height-1;;
  6834. Counter.Y.high := 0;
  6835. Counter.Y.dir := -1;
  6836. end;
  6837. // Read Image
  6838. case Header.ImageType of
  6839. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6840. ReadUncompressed;
  6841. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6842. ReadCompressed;
  6843. end;
  6844. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6845. result := true;
  6846. except
  6847. if Assigned(ImageData) then
  6848. FreeMem(ImageData);
  6849. raise;
  6850. end;
  6851. finally
  6852. aStream.Position := StartPosition;
  6853. end;
  6854. end
  6855. else aStream.Position := StartPosition;
  6856. end;
  6857. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6858. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6859. var
  6860. Header: TTGAHeader;
  6861. Size: Integer;
  6862. FormatDesc: TFormatDescriptor;
  6863. begin
  6864. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6865. raise EglBitmapUnsupportedFormat.Create(Format);
  6866. //prepare header
  6867. FormatDesc := TFormatDescriptor.Get(Format);
  6868. FillChar(Header{%H-}, SizeOf(Header), 0);
  6869. Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
  6870. Header.Bpp := FormatDesc.BitsPerPixel;
  6871. Header.Width := Width;
  6872. Header.Height := Height;
  6873. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6874. if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
  6875. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6876. else
  6877. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6878. aStream.Write(Header, SizeOf(Header));
  6879. // write Data
  6880. Size := FormatDesc.GetSize(Dimension);
  6881. aStream.Write(Data^, Size);
  6882. end;
  6883. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6884. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6885. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6886. const
  6887. DDS_MAGIC: Cardinal = $20534444;
  6888. // DDS_header.dwFlags
  6889. DDSD_CAPS = $00000001;
  6890. DDSD_HEIGHT = $00000002;
  6891. DDSD_WIDTH = $00000004;
  6892. DDSD_PIXELFORMAT = $00001000;
  6893. // DDS_header.sPixelFormat.dwFlags
  6894. DDPF_ALPHAPIXELS = $00000001;
  6895. DDPF_ALPHA = $00000002;
  6896. DDPF_FOURCC = $00000004;
  6897. DDPF_RGB = $00000040;
  6898. DDPF_LUMINANCE = $00020000;
  6899. // DDS_header.sCaps.dwCaps1
  6900. DDSCAPS_TEXTURE = $00001000;
  6901. // DDS_header.sCaps.dwCaps2
  6902. DDSCAPS2_CUBEMAP = $00000200;
  6903. D3DFMT_DXT1 = $31545844;
  6904. D3DFMT_DXT3 = $33545844;
  6905. D3DFMT_DXT5 = $35545844;
  6906. type
  6907. TDDSPixelFormat = packed record
  6908. dwSize: Cardinal;
  6909. dwFlags: Cardinal;
  6910. dwFourCC: Cardinal;
  6911. dwRGBBitCount: Cardinal;
  6912. dwRBitMask: Cardinal;
  6913. dwGBitMask: Cardinal;
  6914. dwBBitMask: Cardinal;
  6915. dwABitMask: Cardinal;
  6916. end;
  6917. TDDSCaps = packed record
  6918. dwCaps1: Cardinal;
  6919. dwCaps2: Cardinal;
  6920. dwDDSX: Cardinal;
  6921. dwReserved: Cardinal;
  6922. end;
  6923. TDDSHeader = packed record
  6924. dwSize: Cardinal;
  6925. dwFlags: Cardinal;
  6926. dwHeight: Cardinal;
  6927. dwWidth: Cardinal;
  6928. dwPitchOrLinearSize: Cardinal;
  6929. dwDepth: Cardinal;
  6930. dwMipMapCount: Cardinal;
  6931. dwReserved: array[0..10] of Cardinal;
  6932. PixelFormat: TDDSPixelFormat;
  6933. Caps: TDDSCaps;
  6934. dwReserved2: Cardinal;
  6935. end;
  6936. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6937. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6938. var
  6939. Header: TDDSHeader;
  6940. Converter: TbmpBitfieldFormat;
  6941. function GetDDSFormat: TglBitmapFormat;
  6942. var
  6943. fd: TFormatDescriptor;
  6944. i: Integer;
  6945. Mask: TglBitmapRec4ul;
  6946. Range: TglBitmapRec4ui;
  6947. match: Boolean;
  6948. begin
  6949. result := tfEmpty;
  6950. with Header.PixelFormat do begin
  6951. // Compresses
  6952. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6953. case Header.PixelFormat.dwFourCC of
  6954. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6955. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6956. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6957. end;
  6958. end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
  6959. // prepare masks
  6960. if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
  6961. Mask.r := dwRBitMask;
  6962. Mask.g := dwGBitMask;
  6963. Mask.b := dwBBitMask;
  6964. end else begin
  6965. Mask.r := dwRBitMask;
  6966. Mask.g := dwRBitMask;
  6967. Mask.b := dwRBitMask;
  6968. end;
  6969. if (dwFlags and DDPF_ALPHAPIXELS > 0) then
  6970. Mask.a := dwABitMask
  6971. else
  6972. Mask.a := 0;;
  6973. //find matching format
  6974. fd := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
  6975. result := fd.Format;
  6976. if (result <> tfEmpty) then
  6977. exit;
  6978. //find format with same Range
  6979. for i := 0 to 3 do
  6980. Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
  6981. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6982. fd := TFormatDescriptor.Get(result);
  6983. match := true;
  6984. for i := 0 to 3 do
  6985. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6986. match := false;
  6987. break;
  6988. end;
  6989. if match then
  6990. break;
  6991. end;
  6992. //no format with same range found -> use default
  6993. if (result = tfEmpty) then begin
  6994. if (dwABitMask > 0) then
  6995. result := tfRGBA8ui1
  6996. else
  6997. result := tfRGB8ub3;
  6998. end;
  6999. Converter := TbmpBitfieldFormat.Create;
  7000. Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
  7001. end;
  7002. end;
  7003. end;
  7004. var
  7005. StreamPos: Int64;
  7006. x, y, LineSize, RowSize, Magic: Cardinal;
  7007. NewImage, TmpData, RowData, SrcData: System.PByte;
  7008. SourceMD, DestMD: Pointer;
  7009. Pixel: TglBitmapPixelData;
  7010. ddsFormat: TglBitmapFormat;
  7011. FormatDesc: TFormatDescriptor;
  7012. begin
  7013. result := false;
  7014. Converter := nil;
  7015. StreamPos := aStream.Position;
  7016. // Magic
  7017. aStream.Read(Magic{%H-}, sizeof(Magic));
  7018. if (Magic <> DDS_MAGIC) then begin
  7019. aStream.Position := StreamPos;
  7020. exit;
  7021. end;
  7022. //Header
  7023. aStream.Read(Header{%H-}, sizeof(Header));
  7024. if (Header.dwSize <> SizeOf(Header)) or
  7025. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  7026. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  7027. begin
  7028. aStream.Position := StreamPos;
  7029. exit;
  7030. end;
  7031. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  7032. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  7033. ddsFormat := GetDDSFormat;
  7034. try
  7035. if (ddsFormat = tfEmpty) then
  7036. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  7037. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  7038. LineSize := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
  7039. GetMem(NewImage, Header.dwHeight * LineSize);
  7040. try
  7041. TmpData := NewImage;
  7042. //Converter needed
  7043. if Assigned(Converter) then begin
  7044. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  7045. GetMem(RowData, RowSize);
  7046. SourceMD := Converter.CreateMappingData;
  7047. DestMD := FormatDesc.CreateMappingData;
  7048. try
  7049. for y := 0 to Header.dwHeight-1 do begin
  7050. TmpData := NewImage;
  7051. inc(TmpData, y * LineSize);
  7052. SrcData := RowData;
  7053. aStream.Read(SrcData^, RowSize);
  7054. for x := 0 to Header.dwWidth-1 do begin
  7055. Converter.Unmap(SrcData, Pixel, SourceMD);
  7056. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  7057. FormatDesc.Map(Pixel, TmpData, DestMD);
  7058. end;
  7059. end;
  7060. finally
  7061. Converter.FreeMappingData(SourceMD);
  7062. FormatDesc.FreeMappingData(DestMD);
  7063. FreeMem(RowData);
  7064. end;
  7065. end else
  7066. // Compressed
  7067. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  7068. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  7069. for Y := 0 to Header.dwHeight-1 do begin
  7070. aStream.Read(TmpData^, RowSize);
  7071. Inc(TmpData, LineSize);
  7072. end;
  7073. end else
  7074. // Uncompressed
  7075. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  7076. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  7077. for Y := 0 to Header.dwHeight-1 do begin
  7078. aStream.Read(TmpData^, RowSize);
  7079. Inc(TmpData, LineSize);
  7080. end;
  7081. end else
  7082. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  7083. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  7084. result := true;
  7085. except
  7086. if Assigned(NewImage) then
  7087. FreeMem(NewImage);
  7088. raise;
  7089. end;
  7090. finally
  7091. FreeAndNil(Converter);
  7092. end;
  7093. end;
  7094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7095. procedure TglBitmap.SaveDDS(const aStream: TStream);
  7096. var
  7097. Header: TDDSHeader;
  7098. FormatDesc: TFormatDescriptor;
  7099. begin
  7100. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  7101. raise EglBitmapUnsupportedFormat.Create(Format);
  7102. FormatDesc := TFormatDescriptor.Get(Format);
  7103. // Generell
  7104. FillChar(Header{%H-}, SizeOf(Header), 0);
  7105. Header.dwSize := SizeOf(Header);
  7106. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  7107. Header.dwWidth := Max(1, Width);
  7108. Header.dwHeight := Max(1, Height);
  7109. // Caps
  7110. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  7111. // Pixelformat
  7112. Header.PixelFormat.dwSize := sizeof(Header);
  7113. if (FormatDesc.IsCompressed) then begin
  7114. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  7115. case Format of
  7116. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  7117. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  7118. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  7119. end;
  7120. end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
  7121. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  7122. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7123. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7124. end else if FormatDesc.IsGrayscale then begin
  7125. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  7126. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7127. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  7128. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7129. end else begin
  7130. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  7131. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7132. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  7133. Header.PixelFormat.dwGBitMask := FormatDesc.Mask.g;
  7134. Header.PixelFormat.dwBBitMask := FormatDesc.Mask.b;
  7135. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7136. end;
  7137. if (FormatDesc.HasAlpha) then
  7138. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  7139. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  7140. aStream.Write(Header, SizeOf(Header));
  7141. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  7142. end;
  7143. {$IFNDEF OPENGL_ES}
  7144. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7145. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7146. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7147. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7148. const aWidth: Integer; const aHeight: Integer);
  7149. var
  7150. pTemp: pByte;
  7151. Size: Integer;
  7152. begin
  7153. if (aHeight > 1) then begin
  7154. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  7155. GetMem(pTemp, Size);
  7156. try
  7157. Move(aData^, pTemp^, Size);
  7158. FreeMem(aData);
  7159. aData := nil;
  7160. except
  7161. FreeMem(pTemp);
  7162. raise;
  7163. end;
  7164. end else
  7165. pTemp := aData;
  7166. inherited SetDataPointer(pTemp, aFormat, aWidth);
  7167. end;
  7168. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7169. function TglBitmap1D.FlipHorz: Boolean;
  7170. var
  7171. Col: Integer;
  7172. pTempDest, pDest, pSource: PByte;
  7173. begin
  7174. result := inherited FlipHorz;
  7175. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  7176. pSource := Data;
  7177. GetMem(pDest, fRowSize);
  7178. try
  7179. pTempDest := pDest;
  7180. Inc(pTempDest, fRowSize);
  7181. for Col := 0 to Width-1 do begin
  7182. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  7183. Move(pSource^, pTempDest^, fPixelSize);
  7184. Inc(pSource, fPixelSize);
  7185. end;
  7186. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  7187. result := true;
  7188. except
  7189. if Assigned(pDest) then
  7190. FreeMem(pDest);
  7191. raise;
  7192. end;
  7193. end;
  7194. end;
  7195. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7196. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  7197. var
  7198. FormatDesc: TFormatDescriptor;
  7199. begin
  7200. // Upload data
  7201. FormatDesc := TFormatDescriptor.Get(Format);
  7202. if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
  7203. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7204. if FormatDesc.IsCompressed then begin
  7205. if not Assigned(glCompressedTexImage1D) then
  7206. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7207. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  7208. end else if aBuildWithGlu then
  7209. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7210. else
  7211. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7212. // Free Data
  7213. if (FreeDataAfterGenTexture) then
  7214. FreeData;
  7215. end;
  7216. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7217. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  7218. var
  7219. BuildWithGlu, TexRec: Boolean;
  7220. TexSize: Integer;
  7221. begin
  7222. if Assigned(Data) then begin
  7223. // Check Texture Size
  7224. if (aTestTextureSize) then begin
  7225. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7226. if (Width > TexSize) then
  7227. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7228. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7229. (Target = GL_TEXTURE_RECTANGLE);
  7230. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7231. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7232. end;
  7233. CreateId;
  7234. SetupParameters(BuildWithGlu);
  7235. UploadData(BuildWithGlu);
  7236. glAreTexturesResident(1, @fID, @fIsResident);
  7237. end;
  7238. end;
  7239. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7240. procedure TglBitmap1D.AfterConstruction;
  7241. begin
  7242. inherited;
  7243. Target := GL_TEXTURE_1D;
  7244. end;
  7245. {$ENDIF}
  7246. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7247. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7248. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7249. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  7250. begin
  7251. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  7252. result := fLines[aIndex]
  7253. else
  7254. result := nil;
  7255. end;
  7256. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7257. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7258. const aWidth: Integer; const aHeight: Integer);
  7259. var
  7260. Idx, LineWidth: Integer;
  7261. begin
  7262. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  7263. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  7264. // Assigning Data
  7265. if Assigned(Data) then begin
  7266. SetLength(fLines, GetHeight);
  7267. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel);
  7268. for Idx := 0 to GetHeight-1 do begin
  7269. fLines[Idx] := Data;
  7270. Inc(fLines[Idx], Idx * LineWidth);
  7271. end;
  7272. end
  7273. else SetLength(fLines, 0);
  7274. end else begin
  7275. SetLength(fLines, 0);
  7276. end;
  7277. end;
  7278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7279. procedure TglBitmap2D.UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
  7280. var
  7281. FormatDesc: TFormatDescriptor;
  7282. begin
  7283. FormatDesc := TFormatDescriptor.Get(Format);
  7284. if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
  7285. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7286. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7287. if FormatDesc.IsCompressed then begin
  7288. if not Assigned(glCompressedTexImage2D) then
  7289. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7290. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  7291. {$IFNDEF OPENGL_ES}
  7292. end else if aBuildWithGlu then begin
  7293. gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height,
  7294. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7295. {$ENDIF}
  7296. end else begin
  7297. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  7298. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7299. end;
  7300. // Freigeben
  7301. if (FreeDataAfterGenTexture) then
  7302. FreeData;
  7303. end;
  7304. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7305. procedure TglBitmap2D.AfterConstruction;
  7306. begin
  7307. inherited;
  7308. Target := GL_TEXTURE_2D;
  7309. end;
  7310. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7311. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  7312. var
  7313. Temp: pByte;
  7314. Size, w, h: Integer;
  7315. FormatDesc: TFormatDescriptor;
  7316. begin
  7317. FormatDesc := TFormatDescriptor.Get(aFormat);
  7318. if FormatDesc.IsCompressed then
  7319. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7320. w := aRight - aLeft;
  7321. h := aBottom - aTop;
  7322. Size := FormatDesc.GetSize(w, h);
  7323. GetMem(Temp, Size);
  7324. try
  7325. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7326. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7327. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  7328. FlipVert;
  7329. except
  7330. if Assigned(Temp) then
  7331. FreeMem(Temp);
  7332. raise;
  7333. end;
  7334. end;
  7335. {$IFNDEF OPENGL_ES}
  7336. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7337. procedure TglBitmap2D.GetDataFromTexture;
  7338. var
  7339. Temp: PByte;
  7340. TempWidth, TempHeight: Integer;
  7341. TempIntFormat: GLint;
  7342. IntFormat: TglBitmapFormat;
  7343. FormatDesc: TFormatDescriptor;
  7344. begin
  7345. Bind;
  7346. // Request Data
  7347. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7348. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7349. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7350. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7351. IntFormat := FormatDesc.Format;
  7352. // Getting data from OpenGL
  7353. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7354. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7355. try
  7356. if FormatDesc.IsCompressed then begin
  7357. if not Assigned(glGetCompressedTexImage) then
  7358. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7359. glGetCompressedTexImage(Target, 0, Temp)
  7360. end else
  7361. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7362. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7363. except
  7364. if Assigned(Temp) then
  7365. FreeMem(Temp);
  7366. raise;
  7367. end;
  7368. end;
  7369. {$ENDIF}
  7370. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7371. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7372. var
  7373. {$IFNDEF OPENGL_ES}
  7374. BuildWithGlu, TexRec: Boolean;
  7375. {$ENDIF}
  7376. PotTex: Boolean;
  7377. TexSize: Integer;
  7378. begin
  7379. if Assigned(Data) then begin
  7380. // Check Texture Size
  7381. if (aTestTextureSize) then begin
  7382. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7383. if ((Height > TexSize) or (Width > TexSize)) then
  7384. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7385. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7386. {$IF NOT DEFINED(OPENGL_ES)}
  7387. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7388. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7389. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7390. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7391. if not PotTex and not GL_OES_texture_npot then
  7392. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7393. {$ELSE}
  7394. if not PotTex then
  7395. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7396. {$IFEND}
  7397. end;
  7398. CreateId;
  7399. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7400. UploadData(Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7401. {$IFNDEF OPENGL_ES}
  7402. glAreTexturesResident(1, @fID, @fIsResident);
  7403. {$ENDIF}
  7404. end;
  7405. end;
  7406. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7407. function TglBitmap2D.FlipHorz: Boolean;
  7408. var
  7409. Col, Row: Integer;
  7410. TempDestData, DestData, SourceData: PByte;
  7411. ImgSize: Integer;
  7412. begin
  7413. result := inherited FlipHorz;
  7414. if Assigned(Data) then begin
  7415. SourceData := Data;
  7416. ImgSize := Height * fRowSize;
  7417. GetMem(DestData, ImgSize);
  7418. try
  7419. TempDestData := DestData;
  7420. Dec(TempDestData, fRowSize + fPixelSize);
  7421. for Row := 0 to Height -1 do begin
  7422. Inc(TempDestData, fRowSize * 2);
  7423. for Col := 0 to Width -1 do begin
  7424. Move(SourceData^, TempDestData^, fPixelSize);
  7425. Inc(SourceData, fPixelSize);
  7426. Dec(TempDestData, fPixelSize);
  7427. end;
  7428. end;
  7429. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7430. result := true;
  7431. except
  7432. if Assigned(DestData) then
  7433. FreeMem(DestData);
  7434. raise;
  7435. end;
  7436. end;
  7437. end;
  7438. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7439. function TglBitmap2D.FlipVert: Boolean;
  7440. var
  7441. Row: Integer;
  7442. TempDestData, DestData, SourceData: PByte;
  7443. begin
  7444. result := inherited FlipVert;
  7445. if Assigned(Data) then begin
  7446. SourceData := Data;
  7447. GetMem(DestData, Height * fRowSize);
  7448. try
  7449. TempDestData := DestData;
  7450. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7451. for Row := 0 to Height -1 do begin
  7452. Move(SourceData^, TempDestData^, fRowSize);
  7453. Dec(TempDestData, fRowSize);
  7454. Inc(SourceData, fRowSize);
  7455. end;
  7456. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7457. result := true;
  7458. except
  7459. if Assigned(DestData) then
  7460. FreeMem(DestData);
  7461. raise;
  7462. end;
  7463. end;
  7464. end;
  7465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7466. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7467. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7468. type
  7469. TMatrixItem = record
  7470. X, Y: Integer;
  7471. W: Single;
  7472. end;
  7473. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7474. TglBitmapToNormalMapRec = Record
  7475. Scale: Single;
  7476. Heights: array of Single;
  7477. MatrixU : array of TMatrixItem;
  7478. MatrixV : array of TMatrixItem;
  7479. end;
  7480. const
  7481. ONE_OVER_255 = 1 / 255;
  7482. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7483. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7484. var
  7485. Val: Single;
  7486. begin
  7487. with FuncRec do begin
  7488. Val :=
  7489. Source.Data.r * LUMINANCE_WEIGHT_R +
  7490. Source.Data.g * LUMINANCE_WEIGHT_G +
  7491. Source.Data.b * LUMINANCE_WEIGHT_B;
  7492. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7493. end;
  7494. end;
  7495. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7496. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7497. begin
  7498. with FuncRec do
  7499. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7500. end;
  7501. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7502. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7503. type
  7504. TVec = Array[0..2] of Single;
  7505. var
  7506. Idx: Integer;
  7507. du, dv: Double;
  7508. Len: Single;
  7509. Vec: TVec;
  7510. function GetHeight(X, Y: Integer): Single;
  7511. begin
  7512. with FuncRec do begin
  7513. X := Max(0, Min(Size.X -1, X));
  7514. Y := Max(0, Min(Size.Y -1, Y));
  7515. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7516. end;
  7517. end;
  7518. begin
  7519. with FuncRec do begin
  7520. with PglBitmapToNormalMapRec(Args)^ do begin
  7521. du := 0;
  7522. for Idx := Low(MatrixU) to High(MatrixU) do
  7523. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7524. dv := 0;
  7525. for Idx := Low(MatrixU) to High(MatrixU) do
  7526. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7527. Vec[0] := -du * Scale;
  7528. Vec[1] := -dv * Scale;
  7529. Vec[2] := 1;
  7530. end;
  7531. // Normalize
  7532. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7533. if Len <> 0 then begin
  7534. Vec[0] := Vec[0] * Len;
  7535. Vec[1] := Vec[1] * Len;
  7536. Vec[2] := Vec[2] * Len;
  7537. end;
  7538. // Farbe zuweisem
  7539. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7540. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7541. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7542. end;
  7543. end;
  7544. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7545. procedure TglBitmap2D.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7546. var
  7547. Rec: TglBitmapToNormalMapRec;
  7548. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7549. begin
  7550. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7551. Matrix[Index].X := X;
  7552. Matrix[Index].Y := Y;
  7553. Matrix[Index].W := W;
  7554. end;
  7555. end;
  7556. begin
  7557. if TFormatDescriptor.Get(Format).IsCompressed then
  7558. raise EglBitmapUnsupportedFormat.Create(Format);
  7559. if aScale > 100 then
  7560. Rec.Scale := 100
  7561. else if aScale < -100 then
  7562. Rec.Scale := -100
  7563. else
  7564. Rec.Scale := aScale;
  7565. SetLength(Rec.Heights, Width * Height);
  7566. try
  7567. case aFunc of
  7568. nm4Samples: begin
  7569. SetLength(Rec.MatrixU, 2);
  7570. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7571. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7572. SetLength(Rec.MatrixV, 2);
  7573. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7574. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7575. end;
  7576. nmSobel: begin
  7577. SetLength(Rec.MatrixU, 6);
  7578. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7579. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7580. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7581. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7582. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7583. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7584. SetLength(Rec.MatrixV, 6);
  7585. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7586. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7587. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7588. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7589. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7590. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7591. end;
  7592. nm3x3: begin
  7593. SetLength(Rec.MatrixU, 6);
  7594. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7595. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7596. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7597. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7598. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7599. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7600. SetLength(Rec.MatrixV, 6);
  7601. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7602. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7603. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7604. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7605. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7606. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7607. end;
  7608. nm5x5: begin
  7609. SetLength(Rec.MatrixU, 20);
  7610. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7611. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7612. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7613. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7614. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7615. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7616. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7617. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7618. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7619. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7620. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7621. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7622. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7623. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7624. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7625. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7626. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7627. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7628. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7629. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7630. SetLength(Rec.MatrixV, 20);
  7631. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7632. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7633. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7634. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7635. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7636. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7637. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7638. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7639. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7640. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7641. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7642. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7643. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7644. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7645. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7646. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7647. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7648. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7649. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7650. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7651. end;
  7652. end;
  7653. // Daten Sammeln
  7654. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7655. Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7656. else
  7657. Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7658. Convert(glBitmapToNormalMapFunc, false, @Rec);
  7659. finally
  7660. SetLength(Rec.Heights, 0);
  7661. end;
  7662. end;
  7663. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7664. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7665. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7666. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7667. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7668. begin
  7669. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7670. end;
  7671. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7672. procedure TglBitmapCubeMap.AfterConstruction;
  7673. begin
  7674. inherited;
  7675. {$IFNDEF OPENGL_ES}
  7676. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7677. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7678. {$ELSE}
  7679. if not (GL_VERSION_2_0) then
  7680. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7681. {$ENDIF}
  7682. SetWrap;
  7683. Target := GL_TEXTURE_CUBE_MAP;
  7684. {$IFNDEF OPENGL_ES}
  7685. fGenMode := GL_REFLECTION_MAP;
  7686. {$ENDIF}
  7687. end;
  7688. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7689. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7690. var
  7691. {$IFNDEF OPENGL_ES}
  7692. BuildWithGlu: Boolean;
  7693. {$ENDIF}
  7694. TexSize: Integer;
  7695. begin
  7696. if (aTestTextureSize) then begin
  7697. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7698. if (Height > TexSize) or (Width > TexSize) then
  7699. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7700. {$IF NOT DEFINED(OPENGL_ES)}
  7701. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7702. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7703. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7704. if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) and not GL_OES_texture_npot then
  7705. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7706. {$ELSE}
  7707. if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) then
  7708. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7709. {$IFEND}
  7710. end;
  7711. if (ID = 0) then
  7712. CreateID;
  7713. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7714. UploadData(aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7715. end;
  7716. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7717. procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
  7718. begin
  7719. inherited Bind (aEnableTextureUnit);
  7720. {$IFNDEF OPENGL_ES}
  7721. if aEnableTexCoordsGen then begin
  7722. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7723. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7724. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7725. glEnable(GL_TEXTURE_GEN_S);
  7726. glEnable(GL_TEXTURE_GEN_T);
  7727. glEnable(GL_TEXTURE_GEN_R);
  7728. end;
  7729. {$ENDIF}
  7730. end;
  7731. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7732. procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
  7733. begin
  7734. inherited Unbind(aDisableTextureUnit);
  7735. {$IFNDEF OPENGL_ES}
  7736. if aDisableTexCoordsGen then begin
  7737. glDisable(GL_TEXTURE_GEN_S);
  7738. glDisable(GL_TEXTURE_GEN_T);
  7739. glDisable(GL_TEXTURE_GEN_R);
  7740. end;
  7741. {$ENDIF}
  7742. end;
  7743. {$IFEND}
  7744. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7745. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7746. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7747. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7748. type
  7749. TVec = Array[0..2] of Single;
  7750. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7751. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7752. TglBitmapNormalMapRec = record
  7753. HalfSize : Integer;
  7754. Func: TglBitmapNormalMapGetVectorFunc;
  7755. end;
  7756. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7757. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7758. begin
  7759. aVec[0] := aHalfSize;
  7760. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7761. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7762. end;
  7763. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7764. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7765. begin
  7766. aVec[0] := - aHalfSize;
  7767. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7768. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7769. end;
  7770. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7771. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7772. begin
  7773. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7774. aVec[1] := aHalfSize;
  7775. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7776. end;
  7777. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7778. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7779. begin
  7780. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7781. aVec[1] := - aHalfSize;
  7782. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7783. end;
  7784. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7785. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7786. begin
  7787. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7788. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7789. aVec[2] := aHalfSize;
  7790. end;
  7791. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7792. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7793. begin
  7794. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7795. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7796. aVec[2] := - aHalfSize;
  7797. end;
  7798. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7799. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7800. var
  7801. i: Integer;
  7802. Vec: TVec;
  7803. Len: Single;
  7804. begin
  7805. with FuncRec do begin
  7806. with PglBitmapNormalMapRec(Args)^ do begin
  7807. Func(Vec, Position, HalfSize);
  7808. // Normalize
  7809. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7810. if Len <> 0 then begin
  7811. Vec[0] := Vec[0] * Len;
  7812. Vec[1] := Vec[1] * Len;
  7813. Vec[2] := Vec[2] * Len;
  7814. end;
  7815. // Scale Vector and AddVectro
  7816. Vec[0] := Vec[0] * 0.5 + 0.5;
  7817. Vec[1] := Vec[1] * 0.5 + 0.5;
  7818. Vec[2] := Vec[2] * 0.5 + 0.5;
  7819. end;
  7820. // Set Color
  7821. for i := 0 to 2 do
  7822. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7823. end;
  7824. end;
  7825. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7826. procedure TglBitmapNormalMap.AfterConstruction;
  7827. begin
  7828. inherited;
  7829. {$IFNDEF OPENGL_ES}
  7830. fGenMode := GL_NORMAL_MAP;
  7831. {$ENDIF}
  7832. end;
  7833. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7834. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7835. var
  7836. Rec: TglBitmapNormalMapRec;
  7837. SizeRec: TglBitmapSize;
  7838. begin
  7839. Rec.HalfSize := aSize div 2;
  7840. FreeDataAfterGenTexture := false;
  7841. SizeRec.Fields := [ffX, ffY];
  7842. SizeRec.X := aSize;
  7843. SizeRec.Y := aSize;
  7844. // Positive X
  7845. Rec.Func := glBitmapNormalMapPosX;
  7846. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7847. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7848. // Negative X
  7849. Rec.Func := glBitmapNormalMapNegX;
  7850. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7851. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7852. // Positive Y
  7853. Rec.Func := glBitmapNormalMapPosY;
  7854. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7855. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7856. // Negative Y
  7857. Rec.Func := glBitmapNormalMapNegY;
  7858. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7859. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7860. // Positive Z
  7861. Rec.Func := glBitmapNormalMapPosZ;
  7862. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7863. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7864. // Negative Z
  7865. Rec.Func := glBitmapNormalMapNegZ;
  7866. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7867. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7868. end;
  7869. {$IFEND}
  7870. initialization
  7871. glBitmapSetDefaultFormat (tfEmpty);
  7872. glBitmapSetDefaultMipmap (mmMipmap);
  7873. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7874. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7875. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7876. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7877. {$IFEND}
  7878. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7879. glBitmapSetDefaultDeleteTextureOnFree (true);
  7880. TFormatDescriptor.Init;
  7881. finalization
  7882. TFormatDescriptor.Finalize;
  7883. end.