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.

9276 line
328 KiB

  1. {***********************************************************
  2. glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  3. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  4. modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
  5. ------------------------------------------------------------
  6. The contents of this file are used with permission, subject to
  7. the Mozilla Public License Version 1.1 (the "License"); you may
  8. not use this file except in compliance with the License. You may
  9. obtain a copy of the License at
  10. http://www.mozilla.org/MPL/MPL-1.1.html
  11. ------------------------------------------------------------
  12. Version 3.0.1
  13. ------------------------------------------------------------
  14. History
  15. 20-11-2013
  16. - refactoring of the complete library
  17. 21-03-2010
  18. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  19. then it's your problem if that isn't true. This prevents the unit for incompatibility
  20. with newer versions of Delphi.
  21. - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  22. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  23. 10-08-2008
  24. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  25. - Additional Datapointer for functioninterface now has the name CustomData
  26. 24-07-2008
  27. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  28. - If you load an texture from an file the property Filename will be set to the name of the file
  29. - Three new properties to attach custom data to the Texture objects
  30. - CustomName (free for use string)
  31. - CustomNameW (free for use widestring)
  32. - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  33. 27-05-2008
  34. - RLE TGAs loaded much faster
  35. 26-05-2008
  36. - fixed some problem with reading RLE TGAs.
  37. 21-05-2008
  38. - function clone now only copys data if it's assigned and now it also copies the ID
  39. - it seems that lazarus dont like comments in comments.
  40. 01-05-2008
  41. - It's possible to set the id of the texture
  42. - define GLB_NO_NATIVE_GL deactivated by default
  43. 27-04-2008
  44. - Now supports the following libraries
  45. - SDL and SDL_image
  46. - libPNG
  47. - libJPEG
  48. - Linux compatibillity via free pascal compatibility (delphi sources optional)
  49. - BMPs now loaded manuel
  50. - Large restructuring
  51. - Property DataPtr now has the name Data
  52. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  53. - Unused Depth removed
  54. - Function FreeData to freeing image data added
  55. 24-10-2007
  56. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  57. 15-11-2006
  58. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  59. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  60. - Function ReadOpenGLExtension is now only intern
  61. 29-06-2006
  62. - pngimage now disabled by default like all other versions.
  63. 26-06-2006
  64. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  65. 22-06-2006
  66. - Fixed some Problem with Delphi 5
  67. - Now uses the newest version of pngimage. Makes saving pngs much easier.
  68. 22-03-2006
  69. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  70. 09-03-2006
  71. - Internal Format ifDepth8 added
  72. - function GrabScreen now supports all uncompressed formats
  73. 31-01-2006
  74. - AddAlphaFromglBitmap implemented
  75. 29-12-2005
  76. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  77. 28-12-2005
  78. - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  79. property Width, Height, Depth are still existing and new property Dimension are avail
  80. 11-12-2005
  81. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  82. 19-10-2005
  83. - Added function GrabScreen to class TglBitmap2D
  84. 18-10-2005
  85. - Added support to Save images
  86. - Added function Clone to Clone Instance
  87. 11-10-2005
  88. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  89. Usefull for Future
  90. - Several speed optimizations
  91. 09-10-2005
  92. - Internal structure change. Loading of TGA, PNG and DDS improved.
  93. Data, format and size will now set directly with SetDataPtr.
  94. - AddFunc now works with all Types of Images and Formats
  95. - Some Funtions moved to Baseclass TglBitmap
  96. 06-10-2005
  97. - Added Support to decompress DXT3 and DXT5 compressed Images.
  98. - Added Mapping to convert data from one format into an other.
  99. 05-10-2005
  100. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  101. supported Input format (supported by GetPixel) into any uncompresed Format
  102. - Added Support to decompress DXT1 compressed Images.
  103. - SwapColors replaced by ConvertTo
  104. 04-10-2005
  105. - Added Support for compressed DDSs
  106. - Added new internal formats (DXT1, DXT3, DXT5)
  107. 29-09-2005
  108. - Parameter Components renamed to InternalFormat
  109. 23-09-2005
  110. - Some AllocMem replaced with GetMem (little speed change)
  111. - better exception handling. Better protection from memory leaks.
  112. 22-09-2005
  113. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
  114. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
  115. 07-09-2005
  116. - Added support for Grayscale textures
  117. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
  118. 10-07-2005
  119. - Added support for GL_VERSION_2_0
  120. - Added support for GL_EXT_texture_filter_anisotropic
  121. 04-07-2005
  122. - Function FillWithColor fills the Image with one Color
  123. - Function LoadNormalMap added
  124. 30-06-2005
  125. - ToNormalMap allows to Create an NormalMap from the Alphachannel
  126. - ToNormalMap now supports Sobel (nmSobel) function.
  127. 29-06-2005
  128. - support for RLE Compressed RGB TGAs added
  129. 28-06-2005
  130. - Class TglBitmapNormalMap added to support Normalmap generation
  131. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
  132. 3 Filters are supported. (4 Samples, 3x3 and 5x5)
  133. 16-06-2005
  134. - Method LoadCubeMapClass removed
  135. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
  136. - virtual abstract method GenTexture in class TglBitmap now is protected
  137. 12-06-2005
  138. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
  139. 10-06-2005
  140. - little enhancement for IsPowerOfTwo
  141. - TglBitmap1D.GenTexture now tests NPOT Textures
  142. 06-06-2005
  143. - some little name changes. All properties or function with Texture in name are
  144. now without texture in name. We have allways texture so we dosn't name it.
  145. 03-06-2005
  146. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
  147. TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
  148. 02-06-2005
  149. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
  150. 25-04-2005
  151. - Function Unbind added
  152. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
  153. 21-04-2005
  154. - class TglBitmapCubeMap added (allows to Create Cubemaps)
  155. 29-03-2005
  156. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
  157. To Enable png's use the define pngimage
  158. 22-03-2005
  159. - New Functioninterface added
  160. - Function GetPixel added
  161. 27-11-2004
  162. - Property BuildMipMaps renamed to MipMap
  163. 21-11-2004
  164. - property Name removed.
  165. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
  166. 22-05-2004
  167. - property name added. Only used in glForms!
  168. 26-11-2003
  169. - property FreeDataAfterGenTexture is now available as default (default = true)
  170. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
  171. - function MoveMemory replaced with function Move (little speed change)
  172. - several calculations stored in variables (little speed change)
  173. 29-09-2003
  174. - property BuildMipsMaps added (default = true)
  175. if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
  176. - property FreeDataAfterGenTexture added (default = true)
  177. if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
  178. - parameter DisableOtherTextureUnits of Bind removed
  179. - parameter FreeDataAfterGeneration of GenTextures removed
  180. 12-09-2003
  181. - TglBitmap dosn't delete data if class was destroyed (fixed)
  182. 09-09-2003
  183. - Bind now enables TextureUnits (by params)
  184. - GenTextures can leave data (by param)
  185. - LoadTextures now optimal
  186. 03-09-2003
  187. - Performance optimization in AddFunc
  188. - procedure Bind moved to subclasses
  189. - Added new Class TglBitmap1D to support real OpenGL 1D Textures
  190. 19-08-2003
  191. - Texturefilter and texturewrap now also as defaults
  192. Minfilter = GL_LINEAR_MIPMAP_LINEAR
  193. Magfilter = GL_LINEAR
  194. Wrap(str) = GL_CLAMP_TO_EDGE
  195. - Added new format tfCompressed to create a compressed texture.
  196. - propertys IsCompressed, TextureSize and IsResident added
  197. IsCompressed and TextureSize only contains data from level 0
  198. 18-08-2003
  199. - Added function AddFunc to add PerPixelEffects to Image
  200. - LoadFromFunc now based on AddFunc
  201. - Invert now based on AddFunc
  202. - SwapColors now based on AddFunc
  203. 16-08-2003
  204. - Added function FlipHorz
  205. 15-08-2003
  206. - Added function LaodFromFunc to create images with function
  207. - Added function FlipVert
  208. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
  209. 29-07-2003
  210. - Added Alphafunctions to calculate alpha per function
  211. - Added Alpha from ColorKey using alphafunctions
  212. 28-07-2003
  213. - First full functionally Version of glBitmap
  214. - Support for 24Bit and 32Bit TGA Pictures added
  215. 25-07-2003
  216. - begin of programming
  217. ***********************************************************}
  218. unit glBitmap;
  219. // Please uncomment the defines below to configure the glBitmap to your preferences.
  220. // If you have configured the unit you can uncomment the warning above.
  221. {.$MESSAGE error 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  223. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  225. // enable OpenGL ES support
  226. {.$DEFINE OPENGL_ES_1_1}
  227. {.$DEFINE OPENGL_ES_2_0}
  228. {.$DEFINE OPENGL_ES_3_0}
  229. {.$DEFINE OPENGL_ES_EXT}
  230. // activate to enable build-in OpenGL support with statically linked methods
  231. // use dglOpenGL.pas if not enabled
  232. {.$DEFINE GLB_NATIVE_OGL_STATIC}
  233. // activate to enable build-in OpenGL support with dynamically linked methods
  234. // use dglOpenGL.pas if not enabled
  235. {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
  236. // activate to enable the support for SDL_surfaces
  237. {.$DEFINE GLB_SDL}
  238. // activate to enable the support for Delphi (including support for Delphi's (not Lazarus') TBitmap)
  239. {.$DEFINE GLB_DELPHI}
  240. // activate to enable the support for TLazIntfImage from Lazarus
  241. {.$DEFINE GLB_LAZARUS}
  242. // activate to enable the support of SDL_image to load files. (READ ONLY)
  243. // If you enable SDL_image all other libraries will be ignored!
  244. {.$DEFINE GLB_SDL_IMAGE}
  245. // activate to enable Lazarus TPortableNetworkGraphic support
  246. // if you enable this pngImage and libPNG will be ignored
  247. {.$DEFINE GLB_LAZ_PNG}
  248. // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
  249. // if you enable pngimage the libPNG will be ignored
  250. {.$DEFINE GLB_PNGIMAGE}
  251. // activate to use the libPNG -> http://www.libpng.org/
  252. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
  253. {.$DEFINE GLB_LIB_PNG}
  254. // activate to enable Lazarus TJPEGImage support
  255. // if you enable this delphi jpegs and libJPEG will be ignored
  256. {.$DEFINE GLB_LAZ_JPEG}
  257. // if you enable delphi jpegs the libJPEG will be ignored
  258. {.$DEFINE GLB_DELPHI_JPEG}
  259. // activate to use the libJPEG -> http://www.ijg.org/
  260. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
  261. {.$DEFINE GLB_LIB_JPEG}
  262. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  263. // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  264. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  265. // Delphi Versions
  266. {$IFDEF fpc}
  267. {$MODE Delphi}
  268. {$IFDEF CPUI386}
  269. {$DEFINE CPU386}
  270. {$ASMMODE INTEL}
  271. {$ENDIF}
  272. {$IFNDEF WINDOWS}
  273. {$linklib c}
  274. {$ENDIF}
  275. {$ENDIF}
  276. // Operation System
  277. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  278. {$DEFINE GLB_WIN}
  279. {$ELSEIF DEFINED(LINUX)}
  280. {$DEFINE GLB_LINUX}
  281. {$IFEND}
  282. // OpenGL ES
  283. {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  284. {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}
  285. {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  286. {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES} {$IFEND}
  287. // native OpenGL Support
  288. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  289. {$IFDEF OPENGL_ES}
  290. {$ERROR 'native OpenGL is not supported yet for OpenGL ES, please use dglOpenGLES.pas instead'}
  291. {$ELSE}
  292. {$DEFINE GLB_NATIVE_OGL}
  293. {$ENDIF}
  294. {$IFEND}
  295. // checking define combinations
  296. //SDL Image
  297. {$IFDEF GLB_SDL_IMAGE}
  298. {$IFNDEF GLB_SDL}
  299. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  300. {$DEFINE GLB_SDL}
  301. {$ENDIF}
  302. {$IFDEF GLB_LAZ_PNG}
  303. {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  304. {$undef GLB_LAZ_PNG}
  305. {$ENDIF}
  306. {$IFDEF GLB_PNGIMAGE}
  307. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  308. {$undef GLB_PNGIMAGE}
  309. {$ENDIF}
  310. {$IFDEF GLB_LAZ_JPEG}
  311. {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  312. {$undef GLB_LAZ_JPEG}
  313. {$ENDIF}
  314. {$IFDEF GLB_DELPHI_JPEG}
  315. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  316. {$undef GLB_DELPHI_JPEG}
  317. {$ENDIF}
  318. {$IFDEF GLB_LIB_PNG}
  319. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  320. {$undef GLB_LIB_PNG}
  321. {$ENDIF}
  322. {$IFDEF GLB_LIB_JPEG}
  323. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  324. {$undef GLB_LIB_JPEG}
  325. {$ENDIF}
  326. {$DEFINE GLB_SUPPORT_PNG_READ}
  327. {$DEFINE GLB_SUPPORT_JPEG_READ}
  328. {$ENDIF}
  329. // Lazarus TPortableNetworkGraphic
  330. {$IFDEF GLB_LAZ_PNG}
  331. {$IFNDEF GLB_LAZARUS}
  332. {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
  333. {$DEFINE GLB_LAZARUS}
  334. {$ENDIF}
  335. {$IFDEF GLB_PNGIMAGE}
  336. {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  337. {$undef GLB_PNGIMAGE}
  338. {$ENDIF}
  339. {$IFDEF GLB_LIB_PNG}
  340. {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  341. {$undef GLB_LIB_PNG}
  342. {$ENDIF}
  343. {$DEFINE GLB_SUPPORT_PNG_READ}
  344. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  345. {$ENDIF}
  346. // PNG Image
  347. {$IFDEF GLB_PNGIMAGE}
  348. {$IFDEF GLB_LIB_PNG}
  349. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  350. {$undef GLB_LIB_PNG}
  351. {$ENDIF}
  352. {$DEFINE GLB_SUPPORT_PNG_READ}
  353. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  354. {$ENDIF}
  355. // libPNG
  356. {$IFDEF GLB_LIB_PNG}
  357. {$DEFINE GLB_SUPPORT_PNG_READ}
  358. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  359. {$ENDIF}
  360. // Lazarus TJPEGImage
  361. {$IFDEF GLB_LAZ_JPEG}
  362. {$IFNDEF GLB_LAZARUS}
  363. {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
  364. {$DEFINE GLB_LAZARUS}
  365. {$ENDIF}
  366. {$IFDEF GLB_DELPHI_JPEG}
  367. {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
  368. {$undef GLB_DELPHI_JPEG}
  369. {$ENDIF}
  370. {$IFDEF GLB_LIB_JPEG}
  371. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
  372. {$undef GLB_LIB_JPEG}
  373. {$ENDIF}
  374. {$DEFINE GLB_SUPPORT_JPEG_READ}
  375. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  376. {$ENDIF}
  377. // JPEG Image
  378. {$IFDEF GLB_DELPHI_JPEG}
  379. {$IFDEF GLB_LIB_JPEG}
  380. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  381. {$undef GLB_LIB_JPEG}
  382. {$ENDIF}
  383. {$DEFINE GLB_SUPPORT_JPEG_READ}
  384. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  385. {$ENDIF}
  386. // libJPEG
  387. {$IFDEF GLB_LIB_JPEG}
  388. {$DEFINE GLB_SUPPORT_JPEG_READ}
  389. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  390. {$ENDIF}
  391. // native OpenGL
  392. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  393. {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
  394. {$IFEND}
  395. // general options
  396. {$EXTENDEDSYNTAX ON}
  397. {$LONGSTRINGS ON}
  398. {$ALIGN ON}
  399. {$IFNDEF FPC}
  400. {$OPTIMIZATION ON}
  401. {$ENDIF}
  402. interface
  403. uses
  404. {$IFNDEF GLB_NATIVE_OGL}
  405. {$IFDEF OPENGL_ES} dglOpenGLES,
  406. {$ELSE} dglOpenGL, {$ENDIF}
  407. {$ENDIF}
  408. {$IF DEFINED(GLB_WIN) AND
  409. (DEFINED(GLB_NATIVE_OGL) OR
  410. DEFINED(GLB_DELPHI))} windows, {$IFEND}
  411. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  412. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  413. {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$ENDIF}
  414. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  415. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  416. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  417. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  418. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  419. Classes, SysUtils;
  420. {$IFDEF GLB_NATIVE_OGL}
  421. const
  422. GL_TRUE = 1;
  423. GL_FALSE = 0;
  424. GL_ZERO = 0;
  425. GL_ONE = 1;
  426. GL_VERSION = $1F02;
  427. GL_EXTENSIONS = $1F03;
  428. GL_TEXTURE_1D = $0DE0;
  429. GL_TEXTURE_2D = $0DE1;
  430. GL_TEXTURE_RECTANGLE = $84F5;
  431. GL_NORMAL_MAP = $8511;
  432. GL_TEXTURE_CUBE_MAP = $8513;
  433. GL_REFLECTION_MAP = $8512;
  434. GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
  435. GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
  436. GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
  437. GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
  438. GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
  439. GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
  440. GL_TEXTURE_WIDTH = $1000;
  441. GL_TEXTURE_HEIGHT = $1001;
  442. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  443. GL_TEXTURE_SWIZZLE_RGBA = $8E46;
  444. GL_S = $2000;
  445. GL_T = $2001;
  446. GL_R = $2002;
  447. GL_Q = $2003;
  448. GL_TEXTURE_GEN_S = $0C60;
  449. GL_TEXTURE_GEN_T = $0C61;
  450. GL_TEXTURE_GEN_R = $0C62;
  451. GL_TEXTURE_GEN_Q = $0C63;
  452. GL_RED = $1903;
  453. GL_GREEN = $1904;
  454. GL_BLUE = $1905;
  455. GL_ALPHA = $1906;
  456. GL_ALPHA4 = $803B;
  457. GL_ALPHA8 = $803C;
  458. GL_ALPHA12 = $803D;
  459. GL_ALPHA16 = $803E;
  460. GL_LUMINANCE = $1909;
  461. GL_LUMINANCE4 = $803F;
  462. GL_LUMINANCE8 = $8040;
  463. GL_LUMINANCE12 = $8041;
  464. GL_LUMINANCE16 = $8042;
  465. GL_LUMINANCE_ALPHA = $190A;
  466. GL_LUMINANCE4_ALPHA4 = $8043;
  467. GL_LUMINANCE6_ALPHA2 = $8044;
  468. GL_LUMINANCE8_ALPHA8 = $8045;
  469. GL_LUMINANCE12_ALPHA4 = $8046;
  470. GL_LUMINANCE12_ALPHA12 = $8047;
  471. GL_LUMINANCE16_ALPHA16 = $8048;
  472. GL_RGB = $1907;
  473. GL_BGR = $80E0;
  474. GL_R3_G3_B2 = $2A10;
  475. GL_RGB4 = $804F;
  476. GL_RGB5 = $8050;
  477. GL_RGB565 = $8D62;
  478. GL_RGB8 = $8051;
  479. GL_RGB10 = $8052;
  480. GL_RGB12 = $8053;
  481. GL_RGB16 = $8054;
  482. GL_RGBA = $1908;
  483. GL_BGRA = $80E1;
  484. GL_RGBA2 = $8055;
  485. GL_RGBA4 = $8056;
  486. GL_RGB5_A1 = $8057;
  487. GL_RGBA8 = $8058;
  488. GL_RGB10_A2 = $8059;
  489. GL_RGBA12 = $805A;
  490. GL_RGBA16 = $805B;
  491. GL_DEPTH_COMPONENT = $1902;
  492. GL_DEPTH_COMPONENT16 = $81A5;
  493. GL_DEPTH_COMPONENT24 = $81A6;
  494. GL_DEPTH_COMPONENT32 = $81A7;
  495. GL_COMPRESSED_RGB = $84ED;
  496. GL_COMPRESSED_RGBA = $84EE;
  497. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  498. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  499. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  500. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  501. GL_UNSIGNED_BYTE = $1401;
  502. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  503. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  504. GL_UNSIGNED_SHORT = $1403;
  505. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  506. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  507. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  508. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  509. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  510. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  511. GL_UNSIGNED_INT = $1405;
  512. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  513. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  514. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  515. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  516. { Texture Filter }
  517. GL_TEXTURE_MAG_FILTER = $2800;
  518. GL_TEXTURE_MIN_FILTER = $2801;
  519. GL_NEAREST = $2600;
  520. GL_NEAREST_MIPMAP_NEAREST = $2700;
  521. GL_NEAREST_MIPMAP_LINEAR = $2702;
  522. GL_LINEAR = $2601;
  523. GL_LINEAR_MIPMAP_NEAREST = $2701;
  524. GL_LINEAR_MIPMAP_LINEAR = $2703;
  525. { Texture Wrap }
  526. GL_TEXTURE_WRAP_S = $2802;
  527. GL_TEXTURE_WRAP_T = $2803;
  528. GL_TEXTURE_WRAP_R = $8072;
  529. GL_CLAMP = $2900;
  530. GL_REPEAT = $2901;
  531. GL_CLAMP_TO_EDGE = $812F;
  532. GL_CLAMP_TO_BORDER = $812D;
  533. GL_MIRRORED_REPEAT = $8370;
  534. { Other }
  535. GL_GENERATE_MIPMAP = $8191;
  536. GL_TEXTURE_BORDER_COLOR = $1004;
  537. GL_MAX_TEXTURE_SIZE = $0D33;
  538. GL_PACK_ALIGNMENT = $0D05;
  539. GL_UNPACK_ALIGNMENT = $0CF5;
  540. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  541. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  542. GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
  543. GL_TEXTURE_GEN_MODE = $2500;
  544. {$IF DEFINED(GLB_WIN)}
  545. libglu = 'glu32.dll';
  546. libopengl = 'opengl32.dll';
  547. {$ELSEIF DEFINED(GLB_LINUX)}
  548. libglu = 'libGLU.so.1';
  549. libopengl = 'libGL.so.1';
  550. {$IFEND}
  551. type
  552. GLboolean = BYTEBOOL;
  553. GLint = Integer;
  554. GLsizei = Integer;
  555. GLuint = Cardinal;
  556. GLfloat = Single;
  557. GLenum = Cardinal;
  558. PGLvoid = Pointer;
  559. PGLboolean = ^GLboolean;
  560. PGLint = ^GLint;
  561. PGLuint = ^GLuint;
  562. PGLfloat = ^GLfloat;
  563. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  564. TglCompressedTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  565. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  566. {$IF DEFINED(GLB_WIN)}
  567. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  568. {$ELSEIF DEFINED(GLB_LINUX)}
  569. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  570. TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
  571. {$IFEND}
  572. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  573. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  574. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  575. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  576. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  577. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  578. TglTexParameteriv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  579. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  580. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  581. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  582. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  583. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  584. TglTexGeni = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  585. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  586. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  587. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  588. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  589. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  590. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  591. TglTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  592. TglTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  593. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  594. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  595. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  596. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  597. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  598. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  599. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  600. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  601. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  602. procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  603. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  604. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  605. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  606. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  607. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  608. procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  609. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  610. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  611. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  612. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  613. procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  614. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  615. procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  616. procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  617. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  618. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  619. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  620. {$IFEND}
  621. var
  622. GL_VERSION_1_2,
  623. GL_VERSION_1_3,
  624. GL_VERSION_1_4,
  625. GL_VERSION_2_0,
  626. GL_VERSION_3_3,
  627. GL_SGIS_generate_mipmap,
  628. GL_ARB_texture_border_clamp,
  629. GL_ARB_texture_mirrored_repeat,
  630. GL_ARB_texture_rectangle,
  631. GL_ARB_texture_non_power_of_two,
  632. GL_ARB_texture_swizzle,
  633. GL_ARB_texture_cube_map,
  634. GL_IBM_texture_mirrored_repeat,
  635. GL_NV_texture_rectangle,
  636. GL_EXT_texture_edge_clamp,
  637. GL_EXT_texture_rectangle,
  638. GL_EXT_texture_swizzle,
  639. GL_EXT_texture_cube_map,
  640. GL_EXT_texture_filter_anisotropic: Boolean;
  641. glCompressedTexImage1D: TglCompressedTexImage1D;
  642. glCompressedTexImage2D: TglCompressedTexImage2D;
  643. glGetCompressedTexImage: TglGetCompressedTexImage;
  644. {$IF DEFINED(GLB_WIN)}
  645. wglGetProcAddress: TwglGetProcAddress;
  646. {$ELSEIF DEFINED(GLB_LINUX)}
  647. glXGetProcAddress: TglXGetProcAddress;
  648. glXGetProcAddressARB: TglXGetProcAddress;
  649. {$IFEND}
  650. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  651. glEnable: TglEnable;
  652. glDisable: TglDisable;
  653. glGetString: TglGetString;
  654. glGetIntegerv: TglGetIntegerv;
  655. glTexParameteri: TglTexParameteri;
  656. glTexParameteriv: TglTexParameteriv;
  657. glTexParameterfv: TglTexParameterfv;
  658. glGetTexParameteriv: TglGetTexParameteriv;
  659. glGetTexParameterfv: TglGetTexParameterfv;
  660. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  661. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  662. glTexGeni: TglTexGeni;
  663. glGenTextures: TglGenTextures;
  664. glBindTexture: TglBindTexture;
  665. glDeleteTextures: TglDeleteTextures;
  666. glAreTexturesResident: TglAreTexturesResident;
  667. glReadPixels: TglReadPixels;
  668. glPixelStorei: TglPixelStorei;
  669. glTexImage1D: TglTexImage1D;
  670. glTexImage2D: TglTexImage2D;
  671. glGetTexImage: TglGetTexImage;
  672. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  673. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  674. {$ENDIF}
  675. {$ENDIF}
  676. type
  677. ////////////////////////////////////////////////////////////////////////////////////////////////////
  678. // the name of formats is composed of the following constituents:
  679. // - multiple chanals:
  680. // - channel (e.g. R, G, B, A or Alpha, Luminance or X (reserved)
  681. // - width of the chanel in bit (4, 8, 16, ...)
  682. // - data type (e.g. ub, us, ui)
  683. // - number of data types
  684. {$IFNDEF fpc}
  685. QWord = System.UInt64;
  686. PQWord = ^QWord;
  687. PtrInt = Longint;
  688. PtrUInt = DWord;
  689. {$ENDIF}
  690. TglBitmapFormat = (
  691. tfEmpty = 0, //must be smallest value!
  692. tfAlpha4ub1, // 1 x unsigned byte
  693. tfAlpha8ub1, // 1 x unsigned byte
  694. tfAlpha16us1, // 1 x unsigned short
  695. tfLuminance4ub1, // 1 x unsigned byte
  696. tfLuminance8ub1, // 1 x unsigned byte
  697. tfLuminance16us1, // 1 x unsigned short
  698. tfLuminance4Alpha4ub2, // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  699. tfLuminance6Alpha2ub2, // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  700. tfLuminance8Alpha8ub2, // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  701. tfLuminance12Alpha4us2, // 1 x unsigned short (lum), 1 x unsigned short (alpha)
  702. tfLuminance16Alpha16us2, // 1 x unsigned short (lum), 1 x unsigned short (alpha)
  703. tfR3G3B2ub1, // 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
  704. tfRGBX4us1, // 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
  705. tfXRGB4us1, // 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
  706. tfR5G6B5us1, // 1 x unsigned short (5bit red, 6bit green, 5bit blue)
  707. tfRGB5X1us1, // 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
  708. tfX1RGB5us1, // 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
  709. tfRGB8ub3, // 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
  710. tfRGBX8ui1, // 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
  711. tfXRGB8ui1, // 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
  712. tfRGB10X2ui1, // 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
  713. tfX2RGB10ui1, // 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
  714. tfRGB16us3, // 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
  715. tfRGBA4us1, // 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
  716. tfARGB4us1, // 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
  717. tfRGB5A1us1, // 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
  718. tfA1RGB5us1, // 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
  719. tfRGBA8ui1, // 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
  720. tfARGB8ui1, // 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
  721. tfRGBA8ub4, // 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
  722. tfRGB10A2ui1, // 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
  723. tfA2RGB10ui1, // 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
  724. tfRGBA16us4, // 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
  725. tfBGRX4us1, // 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
  726. tfXBGR4us1, // 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
  727. tfB5G6R5us1, // 1 x unsigned short (5bit blue, 6bit green, 5bit red)
  728. tfBGR5X1us1, // 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
  729. tfX1BGR5us1, // 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
  730. tfBGR8ub3, // 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
  731. tfBGRX8ui1, // 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
  732. tfXBGR8ui1, // 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
  733. tfBGR10X2ui1, // 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
  734. tfX2BGR10ui1, // 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
  735. tfBGR16us3, // 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
  736. tfBGRA4us1, // 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
  737. tfABGR4us1, // 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
  738. tfBGR5A1us1, // 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
  739. tfA1BGR5us1, // 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
  740. tfBGRA8ui1, // 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
  741. tfABGR8ui1, // 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
  742. tfBGRA8ub4, // 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
  743. tfBGR10A2ui1, // 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
  744. tfA2BGR10ui1, // 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
  745. tfBGRA16us4, // 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
  746. tfDepth16us1, // 1 x unsigned short (depth)
  747. tfDepth24ui1, // 1 x unsigned int (depth)
  748. tfDepth32ui1, // 1 x unsigned int (depth)
  749. tfS3tcDtx1RGBA,
  750. tfS3tcDtx3RGBA,
  751. tfS3tcDtx5RGBA
  752. );
  753. TglBitmapFileType = (
  754. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  755. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  756. ftDDS,
  757. ftTGA,
  758. ftBMP,
  759. ftRAW);
  760. TglBitmapFileTypes = set of TglBitmapFileType;
  761. TglBitmapMipMap = (
  762. mmNone,
  763. mmMipmap,
  764. mmMipmapGlu);
  765. TglBitmapNormalMapFunc = (
  766. nm4Samples,
  767. nmSobel,
  768. nm3x3,
  769. nm5x5);
  770. ////////////////////////////////////////////////////////////////////////////////////////////////////
  771. EglBitmap = class(Exception);
  772. EglBitmapNotSupported = class(Exception);
  773. EglBitmapSizeToLarge = class(EglBitmap);
  774. EglBitmapNonPowerOfTwo = class(EglBitmap);
  775. EglBitmapUnsupportedFormat = class(EglBitmap)
  776. public
  777. constructor Create(const aFormat: TglBitmapFormat); overload;
  778. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  779. end;
  780. ////////////////////////////////////////////////////////////////////////////////////////////////////
  781. TglBitmapRec4ui = packed record
  782. case Integer of
  783. 0: (r, g, b, a: Cardinal);
  784. 1: (arr: array[0..3] of Cardinal);
  785. end;
  786. TglBitmapRec4ub = packed record
  787. case Integer of
  788. 0: (r, g, b, a: Byte);
  789. 1: (arr: array[0..3] of Byte);
  790. end;
  791. TglBitmapRec4ul = packed record
  792. case Integer of
  793. 0: (r, g, b, a: QWord);
  794. 1: (arr: array[0..3] of QWord);
  795. end;
  796. TglBitmapFormatDescriptor = class(TObject)
  797. private
  798. // cached properties
  799. fBytesPerPixel: Single;
  800. fChannelCount: Integer;
  801. fMask: TglBitmapRec4ul;
  802. fRange: TglBitmapRec4ui;
  803. function GetHasRed: Boolean;
  804. function GetHasGreen: Boolean;
  805. function GetHasBlue: Boolean;
  806. function GetHasAlpha: Boolean;
  807. function GetHasColor: Boolean;
  808. function GetIsGrayscale: Boolean;
  809. protected
  810. fFormat: TglBitmapFormat;
  811. fWithAlpha: TglBitmapFormat;
  812. fWithoutAlpha: TglBitmapFormat;
  813. fOpenGLFormat: TglBitmapFormat;
  814. fRGBInverted: TglBitmapFormat;
  815. fUncompressed: TglBitmapFormat;
  816. fBitsPerPixel: Integer;
  817. fIsCompressed: Boolean;
  818. fPrecision: TglBitmapRec4ub;
  819. fShift: TglBitmapRec4ub;
  820. fglFormat: GLenum;
  821. fglInternalFormat: GLenum;
  822. fglDataFormat: GLenum;
  823. procedure SetValues; virtual;
  824. procedure CalcValues;
  825. public
  826. property Format: TglBitmapFormat read fFormat;
  827. property ChannelCount: Integer read fChannelCount;
  828. property IsCompressed: Boolean read fIsCompressed;
  829. property BitsPerPixel: Integer read fBitsPerPixel;
  830. property BytesPerPixel: Single read fBytesPerPixel;
  831. property Precision: TglBitmapRec4ub read fPrecision;
  832. property Shift: TglBitmapRec4ub read fShift;
  833. property Range: TglBitmapRec4ui read fRange;
  834. property Mask: TglBitmapRec4ul read fMask;
  835. property RGBInverted: TglBitmapFormat read fRGBInverted;
  836. property WithAlpha: TglBitmapFormat read fWithAlpha;
  837. property WithoutAlpha: TglBitmapFormat read fWithAlpha;
  838. property OpenGLFormat: TglBitmapFormat read fOpenGLFormat;
  839. property Uncompressed: TglBitmapFormat read fUncompressed;
  840. property glFormat: GLenum read fglFormat;
  841. property glInternalFormat: GLenum read fglInternalFormat;
  842. property glDataFormat: GLenum read fglDataFormat;
  843. property HasRed: Boolean read GetHasRed;
  844. property HasGreen: Boolean read GetHasGreen;
  845. property HasBlue: Boolean read GetHasBlue;
  846. property HasAlpha: Boolean read GetHasAlpha;
  847. property HasColor: Boolean read GetHasColor;
  848. property IsGrayscale: Boolean read GetIsGrayscale;
  849. constructor Create;
  850. public
  851. class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  852. end;
  853. ////////////////////////////////////////////////////////////////////////////////////////////////////
  854. TglBitmapPixelData = packed record
  855. Data: TglBitmapRec4ui;
  856. Range: TglBitmapRec4ui;
  857. Format: TglBitmapFormat;
  858. end;
  859. PglBitmapPixelData = ^TglBitmapPixelData;
  860. TglBitmapPixelPositionFields = set of (ffX, ffY);
  861. TglBitmapPixelPosition = record
  862. Fields : TglBitmapPixelPositionFields;
  863. X : Word;
  864. Y : Word;
  865. end;
  866. ////////////////////////////////////////////////////////////////////////////////////////////////////
  867. TglBitmap = class;
  868. TglBitmapFunctionRec = record
  869. Sender: TglBitmap;
  870. Size: TglBitmapPixelPosition;
  871. Position: TglBitmapPixelPosition;
  872. Source: TglBitmapPixelData;
  873. Dest: TglBitmapPixelData;
  874. Args: Pointer;
  875. end;
  876. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  877. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  878. TglBitmap = class
  879. private
  880. function GetFormatDesc: TglBitmapFormatDescriptor;
  881. protected
  882. fID: GLuint;
  883. fTarget: GLuint;
  884. fAnisotropic: Integer;
  885. fDeleteTextureOnFree: Boolean;
  886. fFreeDataOnDestroy: Boolean;
  887. fFreeDataAfterGenTexture: Boolean;
  888. fData: PByte;
  889. {$IFNDEF OPENGL_ES}
  890. fIsResident: GLboolean;
  891. {$ENDIF}
  892. fBorderColor: array[0..3] of Single;
  893. fDimension: TglBitmapPixelPosition;
  894. fMipMap: TglBitmapMipMap;
  895. fFormat: TglBitmapFormat;
  896. // Mapping
  897. fPixelSize: Integer;
  898. fRowSize: Integer;
  899. // Filtering
  900. fFilterMin: GLenum;
  901. fFilterMag: GLenum;
  902. // TexturWarp
  903. fWrapS: GLenum;
  904. fWrapT: GLenum;
  905. fWrapR: GLenum;
  906. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  907. //Swizzle
  908. fSwizzle: array[0..3] of GLenum;
  909. {$IFEND}
  910. // CustomData
  911. fFilename: String;
  912. fCustomName: String;
  913. fCustomNameW: WideString;
  914. fCustomData: Pointer;
  915. //Getter
  916. function GetWidth: Integer; virtual;
  917. function GetHeight: Integer; virtual;
  918. function GetFileWidth: Integer; virtual;
  919. function GetFileHeight: Integer; virtual;
  920. //Setter
  921. procedure SetCustomData(const aValue: Pointer);
  922. procedure SetCustomName(const aValue: String);
  923. procedure SetCustomNameW(const aValue: WideString);
  924. procedure SetFreeDataOnDestroy(const aValue: Boolean);
  925. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  926. procedure SetFormat(const aValue: TglBitmapFormat);
  927. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  928. procedure SetID(const aValue: Cardinal);
  929. procedure SetMipMap(const aValue: TglBitmapMipMap);
  930. procedure SetTarget(const aValue: Cardinal);
  931. procedure SetAnisotropic(const aValue: Integer);
  932. procedure CreateID;
  933. procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  934. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  935. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method
  936. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  937. function FlipHorz: Boolean; virtual;
  938. function FlipVert: Boolean; virtual;
  939. property Width: Integer read GetWidth;
  940. property Height: Integer read GetHeight;
  941. property FileWidth: Integer read GetFileWidth;
  942. property FileHeight: Integer read GetFileHeight;
  943. public
  944. //Properties
  945. property ID: Cardinal read fID write SetID;
  946. property Target: Cardinal read fTarget write SetTarget;
  947. property Format: TglBitmapFormat read fFormat write SetFormat;
  948. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  949. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  950. property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc;
  951. property Filename: String read fFilename;
  952. property CustomName: String read fCustomName write SetCustomName;
  953. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  954. property CustomData: Pointer read fCustomData write SetCustomData;
  955. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  956. property FreeDataOnDestroy: Boolean read fFreeDataOnDestroy write SetFreeDataOnDestroy;
  957. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  958. property Dimension: TglBitmapPixelPosition read fDimension;
  959. property Data: PByte read fData;
  960. {$IFNDEF OPENGL_ES}
  961. property IsResident: GLboolean read fIsResident;
  962. {$ENDIF}
  963. procedure AfterConstruction; override;
  964. procedure BeforeDestruction; override;
  965. procedure PrepareResType(var aResource: String; var aResType: PChar);
  966. //Load
  967. procedure LoadFromFile(const aFilename: String);
  968. procedure LoadFromStream(const aStream: TStream); virtual;
  969. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  970. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  971. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  972. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  973. //Save
  974. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  975. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  976. //Convert
  977. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  978. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  979. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  980. public
  981. //Alpha & Co
  982. {$IFDEF GLB_SDL}
  983. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  984. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  985. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  986. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  987. const aArgs: Pointer = nil): Boolean;
  988. {$ENDIF}
  989. {$IFDEF GLB_DELPHI}
  990. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  991. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  992. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  993. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  994. const aArgs: Pointer = nil): Boolean;
  995. {$ENDIF}
  996. {$IFDEF GLB_LAZARUS}
  997. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  998. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  999. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  1000. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  1001. const aArgs: Pointer = nil): Boolean;
  1002. {$ENDIF}
  1003. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  1004. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  1005. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  1006. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  1007. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  1008. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  1009. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  1010. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  1011. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  1012. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  1013. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  1014. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  1015. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  1016. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  1017. function RemoveAlpha: Boolean; virtual;
  1018. public
  1019. //Common
  1020. function Clone: TglBitmap;
  1021. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  1022. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  1023. {$IFNDEF OPENGL_ES}
  1024. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  1025. {$ENDIF}
  1026. procedure FreeData;
  1027. //ColorFill
  1028. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  1029. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  1030. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  1031. //TexParameters
  1032. procedure SetFilter(const aMin, aMag: GLenum);
  1033. procedure SetWrap(
  1034. const S: GLenum = GL_CLAMP_TO_EDGE;
  1035. const T: GLenum = GL_CLAMP_TO_EDGE;
  1036. const R: GLenum = GL_CLAMP_TO_EDGE);
  1037. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1038. procedure SetSwizzle(const r, g, b, a: GLenum);
  1039. {$IFEND}
  1040. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  1041. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  1042. //Constructors
  1043. constructor Create; overload;
  1044. constructor Create(const aFileName: String); overload;
  1045. constructor Create(const aStream: TStream); overload;
  1046. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  1047. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  1048. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  1049. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  1050. private
  1051. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  1052. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  1053. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  1054. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  1055. function LoadRAW(const aStream: TStream): Boolean;
  1056. procedure SaveRAW(const aStream: TStream);
  1057. function LoadBMP(const aStream: TStream): Boolean;
  1058. procedure SaveBMP(const aStream: TStream);
  1059. function LoadTGA(const aStream: TStream): Boolean;
  1060. procedure SaveTGA(const aStream: TStream);
  1061. function LoadDDS(const aStream: TStream): Boolean;
  1062. procedure SaveDDS(const aStream: TStream);
  1063. end;
  1064. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1065. {$IFNDEF OPENGL_ES}
  1066. TglBitmap1D = class(TglBitmap)
  1067. protected
  1068. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  1069. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  1070. procedure UploadData(const aBuildWithGlu: Boolean);
  1071. public
  1072. property Width;
  1073. procedure AfterConstruction; override;
  1074. function FlipHorz: Boolean; override;
  1075. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  1076. end;
  1077. {$ENDIF}
  1078. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1079. TglBitmap2D = class(TglBitmap)
  1080. protected
  1081. fLines: array of PByte;
  1082. function GetScanline(const aIndex: Integer): Pointer;
  1083. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  1084. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  1085. procedure UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
  1086. public
  1087. property Width;
  1088. property Height;
  1089. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  1090. procedure AfterConstruction; override;
  1091. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  1092. {$IFNDEF OPENGL_ES}
  1093. procedure GetDataFromTexture;
  1094. {$ENDIF}
  1095. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  1096. function FlipHorz: Boolean; override;
  1097. function FlipVert: Boolean; override;
  1098. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  1099. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  1100. end;
  1101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1102. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  1103. TglBitmapCubeMap = class(TglBitmap2D)
  1104. protected
  1105. {$IFNDEF OPENGL_ES}
  1106. fGenMode: Integer;
  1107. {$ENDIF}
  1108. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  1109. public
  1110. procedure AfterConstruction; override;
  1111. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  1112. procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  1113. procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  1114. end;
  1115. {$IFEND}
  1116. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  1117. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1118. TglBitmapNormalMap = class(TglBitmapCubeMap)
  1119. public
  1120. procedure AfterConstruction; override;
  1121. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  1122. end;
  1123. {$IFEND}
  1124. const
  1125. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1126. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1127. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1128. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1129. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1130. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1131. procedure glBitmapSetDefaultWrap(
  1132. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1133. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1134. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1135. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1136. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1137. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1138. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1139. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1140. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1141. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1142. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1143. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1144. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1145. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1146. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1147. function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
  1148. var
  1149. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1150. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1151. glBitmapDefaultFormat: TglBitmapFormat;
  1152. glBitmapDefaultMipmap: TglBitmapMipMap;
  1153. glBitmapDefaultFilterMin: Cardinal;
  1154. glBitmapDefaultFilterMag: Cardinal;
  1155. glBitmapDefaultWrapS: Cardinal;
  1156. glBitmapDefaultWrapT: Cardinal;
  1157. glBitmapDefaultWrapR: Cardinal;
  1158. glDefaultSwizzle: array[0..3] of GLenum;
  1159. {$IFDEF GLB_DELPHI}
  1160. function CreateGrayPalette: HPALETTE;
  1161. {$ENDIF}
  1162. implementation
  1163. uses
  1164. Math, syncobjs, typinfo
  1165. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1166. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1167. type
  1168. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1169. public
  1170. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1171. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1172. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1173. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1174. function CreateMappingData: Pointer; virtual;
  1175. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1176. function IsEmpty: Boolean; virtual;
  1177. function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
  1178. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1179. constructor Create; virtual;
  1180. public
  1181. class procedure Init;
  1182. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1183. class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1184. class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
  1185. class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  1186. class procedure Clear;
  1187. class procedure Finalize;
  1188. end;
  1189. TFormatDescriptorClass = class of TFormatDescriptor;
  1190. TfdEmpty = class(TFormatDescriptor);
  1191. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1192. TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
  1193. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1194. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1195. end;
  1196. TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
  1197. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1198. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1199. end;
  1200. TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
  1201. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1202. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1203. end;
  1204. TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
  1205. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1206. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1207. end;
  1208. TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
  1209. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1210. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1211. end;
  1212. TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1213. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1214. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1215. end;
  1216. TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
  1217. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1218. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1219. end;
  1220. TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
  1221. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1222. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1223. end;
  1224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1225. TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
  1226. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1227. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1228. end;
  1229. TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
  1230. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1231. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1232. end;
  1233. TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
  1234. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1235. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1236. end;
  1237. TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
  1238. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1239. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1240. end;
  1241. TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
  1242. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1243. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1244. end;
  1245. TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
  1246. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1247. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1248. end;
  1249. TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1250. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1251. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1252. end;
  1253. TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
  1254. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1255. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1256. end;
  1257. TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
  1258. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1259. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1260. end;
  1261. TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1262. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1263. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1264. end;
  1265. TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1266. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1267. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1268. end;
  1269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1270. TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
  1271. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1272. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1273. end;
  1274. TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
  1275. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1276. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1277. end;
  1278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1279. TfdAlpha4ub1 = class(TfdAlphaUB1)
  1280. procedure SetValues; override;
  1281. end;
  1282. TfdAlpha8ub1 = class(TfdAlphaUB1)
  1283. procedure SetValues; override;
  1284. end;
  1285. TfdAlpha16us1 = class(TfdAlphaUS1)
  1286. procedure SetValues; override;
  1287. end;
  1288. TfdLuminance4ub1 = class(TfdLuminanceUB1)
  1289. procedure SetValues; override;
  1290. end;
  1291. TfdLuminance8ub1 = class(TfdLuminanceUB1)
  1292. procedure SetValues; override;
  1293. end;
  1294. TfdLuminance16us1 = class(TfdLuminanceUS1)
  1295. procedure SetValues; override;
  1296. end;
  1297. TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
  1298. procedure SetValues; override;
  1299. end;
  1300. TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
  1301. procedure SetValues; override;
  1302. end;
  1303. TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
  1304. procedure SetValues; override;
  1305. end;
  1306. TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
  1307. procedure SetValues; override;
  1308. end;
  1309. TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
  1310. procedure SetValues; override;
  1311. end;
  1312. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1313. TfdR3G3B2ub1 = class(TfdUniversalUB1)
  1314. procedure SetValues; override;
  1315. end;
  1316. TfdRGBX4us1 = class(TfdUniversalUS1)
  1317. procedure SetValues; override;
  1318. end;
  1319. TfdXRGB4us1 = class(TfdUniversalUS1)
  1320. procedure SetValues; override;
  1321. end;
  1322. TfdR5G6B5us1 = class(TfdUniversalUS1)
  1323. procedure SetValues; override;
  1324. end;
  1325. TfdRGB5X1us1 = class(TfdUniversalUS1)
  1326. procedure SetValues; override;
  1327. end;
  1328. TfdX1RGB5us1 = class(TfdUniversalUS1)
  1329. procedure SetValues; override;
  1330. end;
  1331. TfdRGB8ub3 = class(TfdRGBub3)
  1332. procedure SetValues; override;
  1333. end;
  1334. TfdRGBX8ui1 = class(TfdUniversalUI1)
  1335. procedure SetValues; override;
  1336. end;
  1337. TfdXRGB8ui1 = class(TfdUniversalUI1)
  1338. procedure SetValues; override;
  1339. end;
  1340. TfdRGB10X2ui1 = class(TfdUniversalUI1)
  1341. procedure SetValues; override;
  1342. end;
  1343. TfdX2RGB10ui1 = class(TfdUniversalUI1)
  1344. procedure SetValues; override;
  1345. end;
  1346. TfdRGB16us3 = class(TfdRGBus3)
  1347. procedure SetValues; override;
  1348. end;
  1349. TfdRGBA4us1 = class(TfdUniversalUS1)
  1350. procedure SetValues; override;
  1351. end;
  1352. TfdARGB4us1 = class(TfdUniversalUS1)
  1353. procedure SetValues; override;
  1354. end;
  1355. TfdRGB5A1us1 = class(TfdUniversalUS1)
  1356. procedure SetValues; override;
  1357. end;
  1358. TfdA1RGB5us1 = class(TfdUniversalUS1)
  1359. procedure SetValues; override;
  1360. end;
  1361. TfdRGBA8ui1 = class(TfdUniversalUI1)
  1362. procedure SetValues; override;
  1363. end;
  1364. TfdARGB8ui1 = class(TfdUniversalUI1)
  1365. procedure SetValues; override;
  1366. end;
  1367. TfdRGBA8ub4 = class(TfdRGBAub4)
  1368. procedure SetValues; override;
  1369. end;
  1370. TfdRGB10A2ui1 = class(TfdUniversalUI1)
  1371. procedure SetValues; override;
  1372. end;
  1373. TfdA2RGB10ui1 = class(TfdUniversalUI1)
  1374. procedure SetValues; override;
  1375. end;
  1376. TfdRGBA16us4 = class(TfdRGBAus4)
  1377. procedure SetValues; override;
  1378. end;
  1379. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1380. TfdBGRX4us1 = class(TfdUniversalUS1)
  1381. procedure SetValues; override;
  1382. end;
  1383. TfdXBGR4us1 = class(TfdUniversalUS1)
  1384. procedure SetValues; override;
  1385. end;
  1386. TfdB5G6R5us1 = class(TfdUniversalUS1)
  1387. procedure SetValues; override;
  1388. end;
  1389. TfdBGR5X1us1 = class(TfdUniversalUS1)
  1390. procedure SetValues; override;
  1391. end;
  1392. TfdX1BGR5us1 = class(TfdUniversalUS1)
  1393. procedure SetValues; override;
  1394. end;
  1395. TfdBGR8ub3 = class(TfdBGRub3)
  1396. procedure SetValues; override;
  1397. end;
  1398. TfdBGRX8ui1 = class(TfdUniversalUI1)
  1399. procedure SetValues; override;
  1400. end;
  1401. TfdXBGR8ui1 = class(TfdUniversalUI1)
  1402. procedure SetValues; override;
  1403. end;
  1404. TfdBGR10X2ui1 = class(TfdUniversalUI1)
  1405. procedure SetValues; override;
  1406. end;
  1407. TfdX2BGR10ui1 = class(TfdUniversalUI1)
  1408. procedure SetValues; override;
  1409. end;
  1410. TfdBGR16us3 = class(TfdBGRus3)
  1411. procedure SetValues; override;
  1412. end;
  1413. TfdBGRA4us1 = class(TfdUniversalUS1)
  1414. procedure SetValues; override;
  1415. end;
  1416. TfdABGR4us1 = class(TfdUniversalUS1)
  1417. procedure SetValues; override;
  1418. end;
  1419. TfdBGR5A1us1 = class(TfdUniversalUS1)
  1420. procedure SetValues; override;
  1421. end;
  1422. TfdA1BGR5us1 = class(TfdUniversalUS1)
  1423. procedure SetValues; override;
  1424. end;
  1425. TfdBGRA8ui1 = class(TfdUniversalUI1)
  1426. procedure SetValues; override;
  1427. end;
  1428. TfdABGR8ui1 = class(TfdUniversalUI1)
  1429. procedure SetValues; override;
  1430. end;
  1431. TfdBGRA8ub4 = class(TfdBGRAub4)
  1432. procedure SetValues; override;
  1433. end;
  1434. TfdBGR10A2ui1 = class(TfdUniversalUI1)
  1435. procedure SetValues; override;
  1436. end;
  1437. TfdA2BGR10ui1 = class(TfdUniversalUI1)
  1438. procedure SetValues; override;
  1439. end;
  1440. TfdBGRA16us4 = class(TfdBGRAus4)
  1441. procedure SetValues; override;
  1442. end;
  1443. TfdDepth16us1 = class(TfdDepthUS1)
  1444. procedure SetValues; override;
  1445. end;
  1446. TfdDepth24ui1 = class(TfdDepthUI1)
  1447. procedure SetValues; override;
  1448. end;
  1449. TfdDepth32ui1 = class(TfdDepthUI1)
  1450. procedure SetValues; override;
  1451. end;
  1452. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1453. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1454. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1455. procedure SetValues; override;
  1456. end;
  1457. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1458. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1459. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1460. procedure SetValues; override;
  1461. end;
  1462. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1463. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1464. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1465. procedure SetValues; override;
  1466. end;
  1467. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1468. TbmpBitfieldFormat = class(TFormatDescriptor)
  1469. public
  1470. procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
  1471. procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1472. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1473. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1474. end;
  1475. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1476. TbmpColorTableEnty = packed record
  1477. b, g, r, a: Byte;
  1478. end;
  1479. TbmpColorTable = array of TbmpColorTableEnty;
  1480. TbmpColorTableFormat = class(TFormatDescriptor)
  1481. private
  1482. fBitsPerPixel: Integer;
  1483. fColorTable: TbmpColorTable;
  1484. protected
  1485. procedure SetValues; override;
  1486. public
  1487. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1488. property BitsPerPixel: Integer read fBitsPerPixel write fBitsPerPixel;
  1489. procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1490. procedure CalcValues;
  1491. procedure CreateColorTable;
  1492. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1493. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1494. destructor Destroy; override;
  1495. end;
  1496. const
  1497. LUMINANCE_WEIGHT_R = 0.30;
  1498. LUMINANCE_WEIGHT_G = 0.59;
  1499. LUMINANCE_WEIGHT_B = 0.11;
  1500. ALPHA_WEIGHT_R = 0.30;
  1501. ALPHA_WEIGHT_G = 0.59;
  1502. ALPHA_WEIGHT_B = 0.11;
  1503. DEPTH_WEIGHT_R = 0.333333333;
  1504. DEPTH_WEIGHT_G = 0.333333333;
  1505. DEPTH_WEIGHT_B = 0.333333333;
  1506. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1507. TfdEmpty,
  1508. TfdAlpha4ub1,
  1509. TfdAlpha8ub1,
  1510. TfdAlpha16us1,
  1511. TfdLuminance4ub1,
  1512. TfdLuminance8ub1,
  1513. TfdLuminance16us1,
  1514. TfdLuminance4Alpha4ub2,
  1515. TfdLuminance6Alpha2ub2,
  1516. TfdLuminance8Alpha8ub2,
  1517. TfdLuminance12Alpha4us2,
  1518. TfdLuminance16Alpha16us2,
  1519. TfdR3G3B2ub1,
  1520. TfdRGBX4us1,
  1521. TfdXRGB4us1,
  1522. TfdR5G6B5us1,
  1523. TfdRGB5X1us1,
  1524. TfdX1RGB5us1,
  1525. TfdRGB8ub3,
  1526. TfdRGBX8ui1,
  1527. TfdXRGB8ui1,
  1528. TfdRGB10X2ui1,
  1529. TfdX2RGB10ui1,
  1530. TfdRGB16us3,
  1531. TfdRGBA4us1,
  1532. TfdARGB4us1,
  1533. TfdRGB5A1us1,
  1534. TfdA1RGB5us1,
  1535. TfdRGBA8ui1,
  1536. TfdARGB8ui1,
  1537. TfdRGBA8ub4,
  1538. TfdRGB10A2ui1,
  1539. TfdA2RGB10ui1,
  1540. TfdRGBA16us4,
  1541. TfdBGRX4us1,
  1542. TfdXBGR4us1,
  1543. TfdB5G6R5us1,
  1544. TfdBGR5X1us1,
  1545. TfdX1BGR5us1,
  1546. TfdBGR8ub3,
  1547. TfdBGRX8ui1,
  1548. TfdXBGR8ui1,
  1549. TfdBGR10X2ui1,
  1550. TfdX2BGR10ui1,
  1551. TfdBGR16us3,
  1552. TfdBGRA4us1,
  1553. TfdABGR4us1,
  1554. TfdBGR5A1us1,
  1555. TfdA1BGR5us1,
  1556. TfdBGRA8ui1,
  1557. TfdABGR8ui1,
  1558. TfdBGRA8ub4,
  1559. TfdBGR10A2ui1,
  1560. TfdA2BGR10ui1,
  1561. TfdBGRA16us4,
  1562. TfdDepth16us1,
  1563. TfdDepth24ui1,
  1564. TfdDepth32ui1,
  1565. TfdS3tcDtx1RGBA,
  1566. TfdS3tcDtx3RGBA,
  1567. TfdS3tcDtx5RGBA
  1568. );
  1569. var
  1570. FormatDescriptorCS: TCriticalSection;
  1571. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1572. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1573. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1574. begin
  1575. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1576. end;
  1577. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1578. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1579. begin
  1580. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1581. end;
  1582. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1583. function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
  1584. begin
  1585. result.Fields := [];
  1586. if X >= 0 then
  1587. result.Fields := result.Fields + [ffX];
  1588. if Y >= 0 then
  1589. result.Fields := result.Fields + [ffY];
  1590. result.X := Max(0, X);
  1591. result.Y := Max(0, Y);
  1592. end;
  1593. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1594. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1595. begin
  1596. result.r := r;
  1597. result.g := g;
  1598. result.b := b;
  1599. result.a := a;
  1600. end;
  1601. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1602. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1603. begin
  1604. result.r := r;
  1605. result.g := g;
  1606. result.b := b;
  1607. result.a := a;
  1608. end;
  1609. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1610. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1611. begin
  1612. result.r := r;
  1613. result.g := g;
  1614. result.b := b;
  1615. result.a := a;
  1616. end;
  1617. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1618. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1619. var
  1620. i: Integer;
  1621. begin
  1622. result := false;
  1623. for i := 0 to high(r1.arr) do
  1624. if (r1.arr[i] <> r2.arr[i]) then
  1625. exit;
  1626. result := true;
  1627. end;
  1628. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1629. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1630. var
  1631. i: Integer;
  1632. begin
  1633. result := false;
  1634. for i := 0 to high(r1.arr) do
  1635. if (r1.arr[i] <> r2.arr[i]) then
  1636. exit;
  1637. result := true;
  1638. end;
  1639. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1640. function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
  1641. var
  1642. desc: TFormatDescriptor;
  1643. p, tmp: PByte;
  1644. x, y, i: Integer;
  1645. md: Pointer;
  1646. px: TglBitmapPixelData;
  1647. begin
  1648. result := nil;
  1649. desc := TFormatDescriptor.Get(aFormat);
  1650. if (desc.IsCompressed) or (desc.glFormat = 0) then
  1651. exit;
  1652. p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
  1653. md := desc.CreateMappingData;
  1654. try
  1655. tmp := p;
  1656. desc.PreparePixel(px);
  1657. for y := 0 to 4 do
  1658. for x := 0 to 4 do begin
  1659. px.Data := glBitmapRec4ui(0, 0, 0, 0);
  1660. for i := 0 to 3 do begin
  1661. if ((y < 3) and (y = i)) or
  1662. ((y = 3) and (i < 3)) or
  1663. ((y = 4) and (i = 3))
  1664. then
  1665. px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
  1666. else if ((y < 4) and (i = 3)) or
  1667. ((y = 4) and (i < 3))
  1668. then
  1669. px.Data.arr[i] := px.Range.arr[i]
  1670. else
  1671. px.Data.arr[i] := 0; //px.Range.arr[i];
  1672. end;
  1673. desc.Map(px, tmp, md);
  1674. end;
  1675. finally
  1676. desc.FreeMappingData(md);
  1677. end;
  1678. result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
  1679. result.FreeDataOnDestroy := true;
  1680. result.FreeDataAfterGenTexture := false;
  1681. result.SetFilter(GL_NEAREST, GL_NEAREST);
  1682. end;
  1683. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1684. function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
  1685. begin
  1686. result.r := r;
  1687. result.g := g;
  1688. result.b := b;
  1689. result.a := a;
  1690. end;
  1691. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1692. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1693. begin
  1694. result := [];
  1695. if (aFormat in [
  1696. //8bpp
  1697. tfAlpha4ub1, tfAlpha8ub1,
  1698. tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
  1699. //16bpp
  1700. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1701. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  1702. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
  1703. //24bpp
  1704. tfBGR8ub3, tfRGB8ub3,
  1705. //32bpp
  1706. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  1707. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
  1708. then
  1709. result := result + [ ftBMP ];
  1710. if (aFormat in [
  1711. //8bbp
  1712. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
  1713. //16bbp
  1714. tfAlpha16us1, tfLuminance16us1,
  1715. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1716. tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
  1717. //24bbp
  1718. tfBGR8ub3,
  1719. //32bbp
  1720. tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
  1721. tfDepth24ui1, tfDepth32ui1])
  1722. then
  1723. result := result + [ftTGA];
  1724. if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
  1725. result := result + [ftDDS];
  1726. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1727. if aFormat in [
  1728. tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
  1729. tfRGB8ub3, tfRGBA8ui1,
  1730. tfBGR8ub3, tfBGRA8ui1] then
  1731. result := result + [ftPNG];
  1732. {$ENDIF}
  1733. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1734. if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
  1735. result := result + [ftJPEG];
  1736. {$ENDIF}
  1737. end;
  1738. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1739. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1740. begin
  1741. while (aNumber and 1) = 0 do
  1742. aNumber := aNumber shr 1;
  1743. result := aNumber = 1;
  1744. end;
  1745. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1746. function GetTopMostBit(aBitSet: QWord): Integer;
  1747. begin
  1748. result := 0;
  1749. while aBitSet > 0 do begin
  1750. inc(result);
  1751. aBitSet := aBitSet shr 1;
  1752. end;
  1753. end;
  1754. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1755. function CountSetBits(aBitSet: QWord): Integer;
  1756. begin
  1757. result := 0;
  1758. while aBitSet > 0 do begin
  1759. if (aBitSet and 1) = 1 then
  1760. inc(result);
  1761. aBitSet := aBitSet shr 1;
  1762. end;
  1763. end;
  1764. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1765. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1766. begin
  1767. result := Trunc(
  1768. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1769. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1770. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1771. end;
  1772. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1773. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1774. begin
  1775. result := Trunc(
  1776. DEPTH_WEIGHT_R * aPixel.Data.r +
  1777. DEPTH_WEIGHT_G * aPixel.Data.g +
  1778. DEPTH_WEIGHT_B * aPixel.Data.b);
  1779. end;
  1780. {$IFDEF GLB_NATIVE_OGL}
  1781. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1782. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1783. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1784. var
  1785. GL_LibHandle: Pointer = nil;
  1786. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
  1787. begin
  1788. if not Assigned(aLibHandle) then
  1789. aLibHandle := GL_LibHandle;
  1790. {$IF DEFINED(GLB_WIN)}
  1791. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1792. if Assigned(result) then
  1793. exit;
  1794. if Assigned(wglGetProcAddress) then
  1795. result := wglGetProcAddress(aProcName);
  1796. {$ELSEIF DEFINED(GLB_LINUX)}
  1797. if Assigned(glXGetProcAddress) then begin
  1798. result := glXGetProcAddress(aProcName);
  1799. if Assigned(result) then
  1800. exit;
  1801. end;
  1802. if Assigned(glXGetProcAddressARB) then begin
  1803. result := glXGetProcAddressARB(aProcName);
  1804. if Assigned(result) then
  1805. exit;
  1806. end;
  1807. result := dlsym(aLibHandle, aProcName);
  1808. {$IFEND}
  1809. if not Assigned(result) and aRaiseOnErr then
  1810. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1811. end;
  1812. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1813. var
  1814. GLU_LibHandle: Pointer = nil;
  1815. OpenGLInitialized: Boolean;
  1816. InitOpenGLCS: TCriticalSection;
  1817. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1818. procedure glbInitOpenGL;
  1819. ////////////////////////////////////////////////////////////////////////////////
  1820. function glbLoadLibrary(const aName: PChar): Pointer;
  1821. begin
  1822. {$IF DEFINED(GLB_WIN)}
  1823. result := {%H-}Pointer(LoadLibrary(aName));
  1824. {$ELSEIF DEFINED(GLB_LINUX)}
  1825. result := dlopen(Name, RTLD_LAZY);
  1826. {$ELSE}
  1827. result := nil;
  1828. {$IFEND}
  1829. end;
  1830. ////////////////////////////////////////////////////////////////////////////////
  1831. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1832. begin
  1833. result := false;
  1834. if not Assigned(aLibHandle) then
  1835. exit;
  1836. {$IF DEFINED(GLB_WIN)}
  1837. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1838. {$ELSEIF DEFINED(GLB_LINUX)}
  1839. Result := dlclose(aLibHandle) = 0;
  1840. {$IFEND}
  1841. end;
  1842. begin
  1843. if Assigned(GL_LibHandle) then
  1844. glbFreeLibrary(GL_LibHandle);
  1845. if Assigned(GLU_LibHandle) then
  1846. glbFreeLibrary(GLU_LibHandle);
  1847. GL_LibHandle := glbLoadLibrary(libopengl);
  1848. if not Assigned(GL_LibHandle) then
  1849. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1850. GLU_LibHandle := glbLoadLibrary(libglu);
  1851. if not Assigned(GLU_LibHandle) then
  1852. raise EglBitmap.Create('unable to load library: ' + libglu);
  1853. {$IF DEFINED(GLB_WIN)}
  1854. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1855. {$ELSEIF DEFINED(GLB_LINUX)}
  1856. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1857. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1858. {$IFEND}
  1859. glEnable := glbGetProcAddress('glEnable');
  1860. glDisable := glbGetProcAddress('glDisable');
  1861. glGetString := glbGetProcAddress('glGetString');
  1862. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1863. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1864. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1865. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1866. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1867. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1868. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1869. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1870. glTexGeni := glbGetProcAddress('glTexGeni');
  1871. glGenTextures := glbGetProcAddress('glGenTextures');
  1872. glBindTexture := glbGetProcAddress('glBindTexture');
  1873. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1874. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1875. glReadPixels := glbGetProcAddress('glReadPixels');
  1876. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1877. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1878. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1879. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1880. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1881. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1882. end;
  1883. {$ENDIF}
  1884. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1885. procedure glbReadOpenGLExtensions;
  1886. var
  1887. Buffer: AnsiString;
  1888. MajorVersion, MinorVersion: Integer;
  1889. ///////////////////////////////////////////////////////////////////////////////////////////
  1890. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1891. var
  1892. Separator: Integer;
  1893. begin
  1894. aMinor := 0;
  1895. aMajor := 0;
  1896. Separator := Pos(AnsiString('.'), aBuffer);
  1897. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1898. (aBuffer[Separator - 1] in ['0'..'9']) and
  1899. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1900. Dec(Separator);
  1901. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1902. Dec(Separator);
  1903. Delete(aBuffer, 1, Separator);
  1904. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1905. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1906. Inc(Separator);
  1907. Delete(aBuffer, Separator, 255);
  1908. Separator := Pos(AnsiString('.'), aBuffer);
  1909. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1910. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1911. end;
  1912. end;
  1913. ///////////////////////////////////////////////////////////////////////////////////////////
  1914. function CheckExtension(const Extension: AnsiString): Boolean;
  1915. var
  1916. ExtPos: Integer;
  1917. begin
  1918. ExtPos := Pos(Extension, Buffer);
  1919. result := ExtPos > 0;
  1920. if result then
  1921. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1922. end;
  1923. ///////////////////////////////////////////////////////////////////////////////////////////
  1924. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1925. begin
  1926. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1927. end;
  1928. begin
  1929. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1930. InitOpenGLCS.Enter;
  1931. try
  1932. if not OpenGLInitialized then begin
  1933. glbInitOpenGL;
  1934. OpenGLInitialized := true;
  1935. end;
  1936. finally
  1937. InitOpenGLCS.Leave;
  1938. end;
  1939. {$ENDIF}
  1940. // Version
  1941. Buffer := glGetString(GL_VERSION);
  1942. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1943. GL_VERSION_1_2 := CheckVersion(1, 2);
  1944. GL_VERSION_1_3 := CheckVersion(1, 3);
  1945. GL_VERSION_1_4 := CheckVersion(1, 4);
  1946. GL_VERSION_2_0 := CheckVersion(2, 0);
  1947. GL_VERSION_3_3 := CheckVersion(3, 3);
  1948. // Extensions
  1949. Buffer := glGetString(GL_EXTENSIONS);
  1950. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1951. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1952. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1953. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1954. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1955. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1956. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1957. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1958. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1959. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1960. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1961. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1962. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1963. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1964. if GL_VERSION_1_3 then begin
  1965. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1966. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1967. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1968. end else begin
  1969. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false);
  1970. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false);
  1971. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
  1972. end;
  1973. end;
  1974. {$ENDIF}
  1975. {$IFDEF GLB_SDL_IMAGE}
  1976. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1977. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1978. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1979. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1980. begin
  1981. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1982. end;
  1983. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1984. begin
  1985. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1986. end;
  1987. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1988. begin
  1989. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1990. end;
  1991. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1992. begin
  1993. result := 0;
  1994. end;
  1995. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1996. begin
  1997. result := SDL_AllocRW;
  1998. if result = nil then
  1999. raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  2000. result^.seek := glBitmapRWseek;
  2001. result^.read := glBitmapRWread;
  2002. result^.write := glBitmapRWwrite;
  2003. result^.close := glBitmapRWclose;
  2004. result^.unknown.data1 := Stream;
  2005. end;
  2006. {$ENDIF}
  2007. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2008. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  2009. begin
  2010. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  2011. end;
  2012. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2013. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  2014. begin
  2015. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  2016. end;
  2017. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2018. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  2019. begin
  2020. glBitmapDefaultMipmap := aValue;
  2021. end;
  2022. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2023. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  2024. begin
  2025. glBitmapDefaultFormat := aFormat;
  2026. end;
  2027. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2028. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  2029. begin
  2030. glBitmapDefaultFilterMin := aMin;
  2031. glBitmapDefaultFilterMag := aMag;
  2032. end;
  2033. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2034. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  2035. begin
  2036. glBitmapDefaultWrapS := S;
  2037. glBitmapDefaultWrapT := T;
  2038. glBitmapDefaultWrapR := R;
  2039. end;
  2040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2041. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2042. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  2043. begin
  2044. glDefaultSwizzle[0] := r;
  2045. glDefaultSwizzle[1] := g;
  2046. glDefaultSwizzle[2] := b;
  2047. glDefaultSwizzle[3] := a;
  2048. end;
  2049. {$IFEND}
  2050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2051. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  2052. begin
  2053. result := glBitmapDefaultDeleteTextureOnFree;
  2054. end;
  2055. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2056. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  2057. begin
  2058. result := glBitmapDefaultFreeDataAfterGenTextures;
  2059. end;
  2060. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2061. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  2062. begin
  2063. result := glBitmapDefaultMipmap;
  2064. end;
  2065. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2066. function glBitmapGetDefaultFormat: TglBitmapFormat;
  2067. begin
  2068. result := glBitmapDefaultFormat;
  2069. end;
  2070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2071. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  2072. begin
  2073. aMin := glBitmapDefaultFilterMin;
  2074. aMag := glBitmapDefaultFilterMag;
  2075. end;
  2076. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2077. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  2078. begin
  2079. S := glBitmapDefaultWrapS;
  2080. T := glBitmapDefaultWrapT;
  2081. R := glBitmapDefaultWrapR;
  2082. end;
  2083. {$IFNDEF OPENGL_ES}
  2084. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2085. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  2086. begin
  2087. r := glDefaultSwizzle[0];
  2088. g := glDefaultSwizzle[1];
  2089. b := glDefaultSwizzle[2];
  2090. a := glDefaultSwizzle[3];
  2091. end;
  2092. {$ENDIF}
  2093. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2094. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2095. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2096. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  2097. var
  2098. w, h: Integer;
  2099. begin
  2100. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  2101. w := Max(1, aSize.X);
  2102. h := Max(1, aSize.Y);
  2103. result := GetSize(w, h);
  2104. end else
  2105. result := 0;
  2106. end;
  2107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2108. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  2109. begin
  2110. result := 0;
  2111. if (aWidth <= 0) or (aHeight <= 0) then
  2112. exit;
  2113. result := Ceil(aWidth * aHeight * BytesPerPixel);
  2114. end;
  2115. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2116. function TFormatDescriptor.CreateMappingData: Pointer;
  2117. begin
  2118. result := nil;
  2119. end;
  2120. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2121. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2122. begin
  2123. //DUMMY
  2124. end;
  2125. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2126. function TFormatDescriptor.IsEmpty: Boolean;
  2127. begin
  2128. result := (fFormat = tfEmpty);
  2129. end;
  2130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2131. function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
  2132. var
  2133. i: Integer;
  2134. m: TglBitmapRec4ul;
  2135. begin
  2136. result := false;
  2137. if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
  2138. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2139. m := Mask;
  2140. for i := 0 to 3 do
  2141. if (aMask.arr[i] <> m.arr[i]) then
  2142. exit;
  2143. result := true;
  2144. end;
  2145. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2146. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2147. begin
  2148. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2149. aPixel.Data := Range;
  2150. aPixel.Format := fFormat;
  2151. aPixel.Range := Range;
  2152. end;
  2153. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2154. constructor TFormatDescriptor.Create;
  2155. begin
  2156. inherited Create;
  2157. end;
  2158. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2159. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2160. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2161. procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2162. begin
  2163. aData^ := aPixel.Data.a;
  2164. inc(aData);
  2165. end;
  2166. procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2167. begin
  2168. aPixel.Data.r := 0;
  2169. aPixel.Data.g := 0;
  2170. aPixel.Data.b := 0;
  2171. aPixel.Data.a := aData^;
  2172. inc(aData);
  2173. end;
  2174. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2175. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2176. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2177. procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2178. begin
  2179. aData^ := LuminanceWeight(aPixel);
  2180. inc(aData);
  2181. end;
  2182. procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2183. begin
  2184. aPixel.Data.r := aData^;
  2185. aPixel.Data.g := aData^;
  2186. aPixel.Data.b := aData^;
  2187. aPixel.Data.a := 0;
  2188. inc(aData);
  2189. end;
  2190. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2191. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2192. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2193. procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2194. var
  2195. i: Integer;
  2196. begin
  2197. aData^ := 0;
  2198. for i := 0 to 3 do
  2199. if (Range.arr[i] > 0) then
  2200. aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2201. inc(aData);
  2202. end;
  2203. procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2204. var
  2205. i: Integer;
  2206. begin
  2207. for i := 0 to 3 do
  2208. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
  2209. inc(aData);
  2210. end;
  2211. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2212. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2213. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2214. procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2215. begin
  2216. inherited Map(aPixel, aData, aMapData);
  2217. aData^ := aPixel.Data.a;
  2218. inc(aData);
  2219. end;
  2220. procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2221. begin
  2222. inherited Unmap(aData, aPixel, aMapData);
  2223. aPixel.Data.a := aData^;
  2224. inc(aData);
  2225. end;
  2226. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2227. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2229. procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2230. begin
  2231. aData^ := aPixel.Data.r;
  2232. inc(aData);
  2233. aData^ := aPixel.Data.g;
  2234. inc(aData);
  2235. aData^ := aPixel.Data.b;
  2236. inc(aData);
  2237. end;
  2238. procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2239. begin
  2240. aPixel.Data.r := aData^;
  2241. inc(aData);
  2242. aPixel.Data.g := aData^;
  2243. inc(aData);
  2244. aPixel.Data.b := aData^;
  2245. inc(aData);
  2246. aPixel.Data.a := 0;
  2247. end;
  2248. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2249. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2250. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2251. procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2252. begin
  2253. aData^ := aPixel.Data.b;
  2254. inc(aData);
  2255. aData^ := aPixel.Data.g;
  2256. inc(aData);
  2257. aData^ := aPixel.Data.r;
  2258. inc(aData);
  2259. end;
  2260. procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2261. begin
  2262. aPixel.Data.b := aData^;
  2263. inc(aData);
  2264. aPixel.Data.g := aData^;
  2265. inc(aData);
  2266. aPixel.Data.r := aData^;
  2267. inc(aData);
  2268. aPixel.Data.a := 0;
  2269. end;
  2270. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2271. //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2272. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2273. procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2274. begin
  2275. inherited Map(aPixel, aData, aMapData);
  2276. aData^ := aPixel.Data.a;
  2277. inc(aData);
  2278. end;
  2279. procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2280. begin
  2281. inherited Unmap(aData, aPixel, aMapData);
  2282. aPixel.Data.a := aData^;
  2283. inc(aData);
  2284. end;
  2285. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2286. //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2287. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2288. procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2289. begin
  2290. inherited Map(aPixel, aData, aMapData);
  2291. aData^ := aPixel.Data.a;
  2292. inc(aData);
  2293. end;
  2294. procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2295. begin
  2296. inherited Unmap(aData, aPixel, aMapData);
  2297. aPixel.Data.a := aData^;
  2298. inc(aData);
  2299. end;
  2300. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2301. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2302. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2303. procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2304. begin
  2305. PWord(aData)^ := aPixel.Data.a;
  2306. inc(aData, 2);
  2307. end;
  2308. procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2309. begin
  2310. aPixel.Data.r := 0;
  2311. aPixel.Data.g := 0;
  2312. aPixel.Data.b := 0;
  2313. aPixel.Data.a := PWord(aData)^;
  2314. inc(aData, 2);
  2315. end;
  2316. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2317. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2318. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2319. procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2320. begin
  2321. PWord(aData)^ := LuminanceWeight(aPixel);
  2322. inc(aData, 2);
  2323. end;
  2324. procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2325. begin
  2326. aPixel.Data.r := PWord(aData)^;
  2327. aPixel.Data.g := PWord(aData)^;
  2328. aPixel.Data.b := PWord(aData)^;
  2329. aPixel.Data.a := 0;
  2330. inc(aData, 2);
  2331. end;
  2332. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2333. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2334. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2335. procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2336. var
  2337. i: Integer;
  2338. begin
  2339. PWord(aData)^ := 0;
  2340. for i := 0 to 3 do
  2341. if (Range.arr[i] > 0) then
  2342. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2343. inc(aData, 2);
  2344. end;
  2345. procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2346. var
  2347. i: Integer;
  2348. begin
  2349. for i := 0 to 3 do
  2350. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2351. inc(aData, 2);
  2352. end;
  2353. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2354. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2355. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2356. procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2357. begin
  2358. PWord(aData)^ := DepthWeight(aPixel);
  2359. inc(aData, 2);
  2360. end;
  2361. procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2362. begin
  2363. aPixel.Data.r := PWord(aData)^;
  2364. aPixel.Data.g := PWord(aData)^;
  2365. aPixel.Data.b := PWord(aData)^;
  2366. aPixel.Data.a := PWord(aData)^;;
  2367. inc(aData, 2);
  2368. end;
  2369. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2370. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2371. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2372. procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2373. begin
  2374. inherited Map(aPixel, aData, aMapData);
  2375. PWord(aData)^ := aPixel.Data.a;
  2376. inc(aData, 2);
  2377. end;
  2378. procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2379. begin
  2380. inherited Unmap(aData, aPixel, aMapData);
  2381. aPixel.Data.a := PWord(aData)^;
  2382. inc(aData, 2);
  2383. end;
  2384. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2385. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2386. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2387. procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2388. begin
  2389. PWord(aData)^ := aPixel.Data.r;
  2390. inc(aData, 2);
  2391. PWord(aData)^ := aPixel.Data.g;
  2392. inc(aData, 2);
  2393. PWord(aData)^ := aPixel.Data.b;
  2394. inc(aData, 2);
  2395. end;
  2396. procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2397. begin
  2398. aPixel.Data.r := PWord(aData)^;
  2399. inc(aData, 2);
  2400. aPixel.Data.g := PWord(aData)^;
  2401. inc(aData, 2);
  2402. aPixel.Data.b := PWord(aData)^;
  2403. inc(aData, 2);
  2404. aPixel.Data.a := 0;
  2405. end;
  2406. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2407. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2408. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2409. procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2410. begin
  2411. PWord(aData)^ := aPixel.Data.b;
  2412. inc(aData, 2);
  2413. PWord(aData)^ := aPixel.Data.g;
  2414. inc(aData, 2);
  2415. PWord(aData)^ := aPixel.Data.r;
  2416. inc(aData, 2);
  2417. end;
  2418. procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2419. begin
  2420. aPixel.Data.b := PWord(aData)^;
  2421. inc(aData, 2);
  2422. aPixel.Data.g := PWord(aData)^;
  2423. inc(aData, 2);
  2424. aPixel.Data.r := PWord(aData)^;
  2425. inc(aData, 2);
  2426. aPixel.Data.a := 0;
  2427. end;
  2428. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2429. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2430. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2431. procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2432. begin
  2433. inherited Map(aPixel, aData, aMapData);
  2434. PWord(aData)^ := aPixel.Data.a;
  2435. inc(aData, 2);
  2436. end;
  2437. procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2438. begin
  2439. inherited Unmap(aData, aPixel, aMapData);
  2440. aPixel.Data.a := PWord(aData)^;
  2441. inc(aData, 2);
  2442. end;
  2443. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2444. //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2446. procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2447. begin
  2448. PWord(aData)^ := aPixel.Data.a;
  2449. inc(aData, 2);
  2450. inherited Map(aPixel, aData, aMapData);
  2451. end;
  2452. procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2453. begin
  2454. aPixel.Data.a := PWord(aData)^;
  2455. inc(aData, 2);
  2456. inherited Unmap(aData, aPixel, aMapData);
  2457. end;
  2458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2459. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2460. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2461. procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2462. begin
  2463. inherited Map(aPixel, aData, aMapData);
  2464. PWord(aData)^ := aPixel.Data.a;
  2465. inc(aData, 2);
  2466. end;
  2467. procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2468. begin
  2469. inherited Unmap(aData, aPixel, aMapData);
  2470. aPixel.Data.a := PWord(aData)^;
  2471. inc(aData, 2);
  2472. end;
  2473. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2474. //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2475. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2476. procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2477. begin
  2478. PWord(aData)^ := aPixel.Data.a;
  2479. inc(aData, 2);
  2480. inherited Map(aPixel, aData, aMapData);
  2481. end;
  2482. procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2483. begin
  2484. aPixel.Data.a := PWord(aData)^;
  2485. inc(aData, 2);
  2486. inherited Unmap(aData, aPixel, aMapData);
  2487. end;
  2488. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2489. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2490. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2491. procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2492. var
  2493. i: Integer;
  2494. begin
  2495. PCardinal(aData)^ := 0;
  2496. for i := 0 to 3 do
  2497. if (Range.arr[i] > 0) then
  2498. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2499. inc(aData, 4);
  2500. end;
  2501. procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2502. var
  2503. i: Integer;
  2504. begin
  2505. for i := 0 to 3 do
  2506. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2507. inc(aData, 2);
  2508. end;
  2509. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2510. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2511. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2512. procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2513. begin
  2514. PCardinal(aData)^ := DepthWeight(aPixel);
  2515. inc(aData, 4);
  2516. end;
  2517. procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2518. begin
  2519. aPixel.Data.r := PCardinal(aData)^;
  2520. aPixel.Data.g := PCardinal(aData)^;
  2521. aPixel.Data.b := PCardinal(aData)^;
  2522. aPixel.Data.a := PCardinal(aData)^;
  2523. inc(aData, 4);
  2524. end;
  2525. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2526. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2527. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2528. procedure TfdAlpha4ub1.SetValues;
  2529. begin
  2530. inherited SetValues;
  2531. fBitsPerPixel := 8;
  2532. fFormat := tfAlpha4ub1;
  2533. fWithAlpha := tfAlpha4ub1;
  2534. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2535. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2536. {$IFNDEF OPENGL_ES}
  2537. fOpenGLFormat := tfAlpha4ub1;
  2538. fglFormat := GL_ALPHA;
  2539. fglInternalFormat := GL_ALPHA4;
  2540. fglDataFormat := GL_UNSIGNED_BYTE;
  2541. {$ELSE}
  2542. fOpenGLFormat := tfAlpha8ub1;
  2543. {$ENDIF}
  2544. end;
  2545. procedure TfdAlpha8ub1.SetValues;
  2546. begin
  2547. inherited SetValues;
  2548. fBitsPerPixel := 8;
  2549. fFormat := tfAlpha8ub1;
  2550. fWithAlpha := tfAlpha8ub1;
  2551. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2552. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2553. fOpenGLFormat := tfAlpha8ub1;
  2554. fglFormat := GL_ALPHA;
  2555. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
  2556. fglDataFormat := GL_UNSIGNED_BYTE;
  2557. end;
  2558. procedure TfdAlpha16us1.SetValues;
  2559. begin
  2560. inherited SetValues;
  2561. fBitsPerPixel := 16;
  2562. fFormat := tfAlpha16us1;
  2563. fWithAlpha := tfAlpha16us1;
  2564. fPrecision := glBitmapRec4ub(0, 0, 0, 16);
  2565. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2566. {$IFNDEF OPENGL_ES}
  2567. fOpenGLFormat := tfAlpha16us1;
  2568. fglFormat := GL_ALPHA;
  2569. fglInternalFormat := GL_ALPHA16;
  2570. fglDataFormat := GL_UNSIGNED_SHORT;
  2571. {$ELSE}
  2572. fOpenGLFormat := tfAlpha8ub1;
  2573. {$ENDIF}
  2574. end;
  2575. procedure TfdLuminance4ub1.SetValues;
  2576. begin
  2577. inherited SetValues;
  2578. fBitsPerPixel := 8;
  2579. fFormat := tfLuminance4ub1;
  2580. fWithAlpha := tfLuminance4Alpha4ub2;
  2581. fWithoutAlpha := tfLuminance4ub1;
  2582. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2583. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2584. {$IFNDEF OPENGL_ES}
  2585. fOpenGLFormat := tfLuminance4ub1;
  2586. fglFormat := GL_LUMINANCE;
  2587. fglInternalFormat := GL_LUMINANCE4;
  2588. fglDataFormat := GL_UNSIGNED_BYTE;
  2589. {$ELSE}
  2590. fOpenGLFormat := tfLuminance8ub1;
  2591. {$ENDIF}
  2592. end;
  2593. procedure TfdLuminance8ub1.SetValues;
  2594. begin
  2595. inherited SetValues;
  2596. fBitsPerPixel := 8;
  2597. fFormat := tfLuminance8ub1;
  2598. fWithAlpha := tfLuminance8Alpha8ub2;
  2599. fWithoutAlpha := tfLuminance8ub1;
  2600. fOpenGLFormat := tfLuminance8ub1;
  2601. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2602. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2603. fglFormat := GL_LUMINANCE;
  2604. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
  2605. fglDataFormat := GL_UNSIGNED_BYTE;
  2606. end;
  2607. procedure TfdLuminance16us1.SetValues;
  2608. begin
  2609. inherited SetValues;
  2610. fBitsPerPixel := 16;
  2611. fFormat := tfLuminance16us1;
  2612. fWithAlpha := tfLuminance16Alpha16us2;
  2613. fWithoutAlpha := tfLuminance16us1;
  2614. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2615. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  2616. {$IFNDEF OPENGL_ES}
  2617. fOpenGLFormat := tfLuminance16us1;
  2618. fglFormat := GL_LUMINANCE;
  2619. fglInternalFormat := GL_LUMINANCE16;
  2620. fglDataFormat := GL_UNSIGNED_SHORT;
  2621. {$ELSE}
  2622. fOpenGLFormat := tfLuminance8ub1;
  2623. {$ENDIF}
  2624. end;
  2625. procedure TfdLuminance4Alpha4ub2.SetValues;
  2626. begin
  2627. inherited SetValues;
  2628. fBitsPerPixel := 16;
  2629. fFormat := tfLuminance4Alpha4ub2;
  2630. fWithAlpha := tfLuminance4Alpha4ub2;
  2631. fWithoutAlpha := tfLuminance4ub1;
  2632. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2633. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2634. {$IFNDEF OPENGL_ES}
  2635. fOpenGLFormat := tfLuminance4Alpha4ub2;
  2636. fglFormat := GL_LUMINANCE_ALPHA;
  2637. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2638. fglDataFormat := GL_UNSIGNED_BYTE;
  2639. {$ELSE}
  2640. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2641. {$ENDIF}
  2642. end;
  2643. procedure TfdLuminance6Alpha2ub2.SetValues;
  2644. begin
  2645. inherited SetValues;
  2646. fBitsPerPixel := 16;
  2647. fFormat := tfLuminance6Alpha2ub2;
  2648. fWithAlpha := tfLuminance6Alpha2ub2;
  2649. fWithoutAlpha := tfLuminance8ub1;
  2650. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2651. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2652. {$IFNDEF OPENGL_ES}
  2653. fOpenGLFormat := tfLuminance6Alpha2ub2;
  2654. fglFormat := GL_LUMINANCE_ALPHA;
  2655. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2656. fglDataFormat := GL_UNSIGNED_BYTE;
  2657. {$ELSE}
  2658. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2659. {$ENDIF}
  2660. end;
  2661. procedure TfdLuminance8Alpha8ub2.SetValues;
  2662. begin
  2663. inherited SetValues;
  2664. fBitsPerPixel := 16;
  2665. fFormat := tfLuminance8Alpha8ub2;
  2666. fWithAlpha := tfLuminance8Alpha8ub2;
  2667. fWithoutAlpha := tfLuminance8ub1;
  2668. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2669. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2670. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2671. fglFormat := GL_LUMINANCE_ALPHA;
  2672. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
  2673. fglDataFormat := GL_UNSIGNED_BYTE;
  2674. end;
  2675. procedure TfdLuminance12Alpha4us2.SetValues;
  2676. begin
  2677. inherited SetValues;
  2678. fBitsPerPixel := 32;
  2679. fFormat := tfLuminance12Alpha4us2;
  2680. fWithAlpha := tfLuminance12Alpha4us2;
  2681. fWithoutAlpha := tfLuminance16us1;
  2682. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2683. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2684. {$IFNDEF OPENGL_ES}
  2685. fOpenGLFormat := tfLuminance12Alpha4us2;
  2686. fglFormat := GL_LUMINANCE_ALPHA;
  2687. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2688. fglDataFormat := GL_UNSIGNED_SHORT;
  2689. {$ELSE}
  2690. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2691. {$ENDIF}
  2692. end;
  2693. procedure TfdLuminance16Alpha16us2.SetValues;
  2694. begin
  2695. inherited SetValues;
  2696. fBitsPerPixel := 32;
  2697. fFormat := tfLuminance16Alpha16us2;
  2698. fWithAlpha := tfLuminance16Alpha16us2;
  2699. fWithoutAlpha := tfLuminance16us1;
  2700. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2701. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2702. {$IFNDEF OPENGL_ES}
  2703. fOpenGLFormat := tfLuminance16Alpha16us2;
  2704. fglFormat := GL_LUMINANCE_ALPHA;
  2705. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2706. fglDataFormat := GL_UNSIGNED_SHORT;
  2707. {$ELSE}
  2708. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2709. {$ENDIF}
  2710. end;
  2711. procedure TfdR3G3B2ub1.SetValues;
  2712. begin
  2713. inherited SetValues;
  2714. fBitsPerPixel := 8;
  2715. fFormat := tfR3G3B2ub1;
  2716. fWithAlpha := tfRGBA4us1;
  2717. fWithoutAlpha := tfR3G3B2ub1;
  2718. fRGBInverted := tfEmpty;
  2719. fPrecision := glBitmapRec4ub(3, 3, 2, 0);
  2720. fShift := glBitmapRec4ub(5, 2, 0, 0);
  2721. {$IFNDEF OPENGL_ES}
  2722. fOpenGLFormat := tfR3G3B2ub1;
  2723. fglFormat := GL_RGB;
  2724. fglInternalFormat := GL_R3_G3_B2;
  2725. fglDataFormat := GL_UNSIGNED_BYTE_3_3_2;
  2726. {$ELSE}
  2727. fOpenGLFormat := tfR5G6B5us1;
  2728. {$ENDIF}
  2729. end;
  2730. procedure TfdRGBX4us1.SetValues;
  2731. begin
  2732. inherited SetValues;
  2733. fBitsPerPixel := 16;
  2734. fFormat := tfRGBX4us1;
  2735. fWithAlpha := tfRGBA4us1;
  2736. fWithoutAlpha := tfRGBX4us1;
  2737. fRGBInverted := tfBGRX4us1;
  2738. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2739. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2740. {$IFNDEF OPENGL_ES}
  2741. fOpenGLFormat := tfRGBX4us1;
  2742. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2743. fglInternalFormat := GL_RGB4;
  2744. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2745. {$ELSE}
  2746. fOpenGLFormat := tfR5G6B5us1;
  2747. {$ENDIF}
  2748. end;
  2749. procedure TfdXRGB4us1.SetValues;
  2750. begin
  2751. inherited SetValues;
  2752. fBitsPerPixel := 16;
  2753. fFormat := tfXRGB4us1;
  2754. fWithAlpha := tfARGB4us1;
  2755. fWithoutAlpha := tfXRGB4us1;
  2756. fRGBInverted := tfXBGR4us1;
  2757. fPrecision := glBitmapRec4ub(4, 4, 4, 0);
  2758. fShift := glBitmapRec4ub(8, 4, 0, 0);
  2759. {$IFNDEF OPENGL_ES}
  2760. fOpenGLFormat := tfXRGB4us1;
  2761. fglFormat := GL_BGRA;
  2762. fglInternalFormat := GL_RGB4;
  2763. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2764. {$ELSE}
  2765. fOpenGLFormat := tfR5G6B5us1;
  2766. {$ENDIF}
  2767. end;
  2768. procedure TfdR5G6B5us1.SetValues;
  2769. begin
  2770. inherited SetValues;
  2771. fBitsPerPixel := 16;
  2772. fFormat := tfR5G6B5us1;
  2773. fWithAlpha := tfRGB5A1us1;
  2774. fWithoutAlpha := tfR5G6B5us1;
  2775. fRGBInverted := tfB5G6R5us1;
  2776. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2777. fShift := glBitmapRec4ub(11, 5, 0, 0);
  2778. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  2779. fOpenGLFormat := tfR5G6B5us1;
  2780. fglFormat := GL_RGB;
  2781. fglInternalFormat := GL_RGB565;
  2782. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2783. {$ELSE}
  2784. fOpenGLFormat := tfRGB8ub3;
  2785. {$IFEND}
  2786. end;
  2787. procedure TfdRGB5X1us1.SetValues;
  2788. begin
  2789. inherited SetValues;
  2790. fBitsPerPixel := 16;
  2791. fFormat := tfRGB5X1us1;
  2792. fWithAlpha := tfRGB5A1us1;
  2793. fWithoutAlpha := tfRGB5X1us1;
  2794. fRGBInverted := tfBGR5X1us1;
  2795. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2796. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2797. {$IFNDEF OPENGL_ES}
  2798. fOpenGLFormat := tfRGB5X1us1;
  2799. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2800. fglInternalFormat := GL_RGB5;
  2801. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2802. {$ELSE}
  2803. fOpenGLFormat := tfR5G6B5us1;
  2804. {$ENDIF}
  2805. end;
  2806. procedure TfdX1RGB5us1.SetValues;
  2807. begin
  2808. inherited SetValues;
  2809. fBitsPerPixel := 16;
  2810. fFormat := tfX1RGB5us1;
  2811. fWithAlpha := tfA1RGB5us1;
  2812. fWithoutAlpha := tfX1RGB5us1;
  2813. fRGBInverted := tfX1BGR5us1;
  2814. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2815. fShift := glBitmapRec4ub(10, 5, 0, 0);
  2816. {$IFNDEF OPENGL_ES}
  2817. fOpenGLFormat := tfX1RGB5us1;
  2818. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2819. fglInternalFormat := GL_RGB5;
  2820. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2821. {$ELSE}
  2822. fOpenGLFormat := tfR5G6B5us1;
  2823. {$ENDIF}
  2824. end;
  2825. procedure TfdRGB8ub3.SetValues;
  2826. begin
  2827. inherited SetValues;
  2828. fBitsPerPixel := 24;
  2829. fFormat := tfRGB8ub3;
  2830. fWithAlpha := tfRGBA8ub4;
  2831. fWithoutAlpha := tfRGB8ub3;
  2832. fRGBInverted := tfBGR8ub3;
  2833. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2834. fShift := glBitmapRec4ub(0, 8, 16, 0);
  2835. fOpenGLFormat := tfRGB8ub3;
  2836. fglFormat := GL_RGB;
  2837. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
  2838. fglDataFormat := GL_UNSIGNED_BYTE;
  2839. end;
  2840. procedure TfdRGBX8ui1.SetValues;
  2841. begin
  2842. inherited SetValues;
  2843. fBitsPerPixel := 32;
  2844. fFormat := tfRGBX8ui1;
  2845. fWithAlpha := tfRGBA8ui1;
  2846. fWithoutAlpha := tfRGBX8ui1;
  2847. fRGBInverted := tfBGRX8ui1;
  2848. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2849. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2850. {$IFNDEF OPENGL_ES}
  2851. fOpenGLFormat := tfRGBX8ui1;
  2852. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2853. fglInternalFormat := GL_RGB8;
  2854. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2855. {$ELSE}
  2856. fOpenGLFormat := tfRGB8ub3;
  2857. {$ENDIF}
  2858. end;
  2859. procedure TfdXRGB8ui1.SetValues;
  2860. begin
  2861. inherited SetValues;
  2862. fBitsPerPixel := 32;
  2863. fFormat := tfXRGB8ui1;
  2864. fWithAlpha := tfXRGB8ui1;
  2865. fWithoutAlpha := tfXRGB8ui1;
  2866. fOpenGLFormat := tfXRGB8ui1;
  2867. fRGBInverted := tfXBGR8ui1;
  2868. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2869. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2870. {$IFNDEF OPENGL_ES}
  2871. fOpenGLFormat := tfXRGB8ui1;
  2872. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2873. fglInternalFormat := GL_RGB8;
  2874. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2875. {$ELSE}
  2876. fOpenGLFormat := tfRGB8ub3;
  2877. {$ENDIF}
  2878. end;
  2879. procedure TfdRGB10X2ui1.SetValues;
  2880. begin
  2881. inherited SetValues;
  2882. fBitsPerPixel := 32;
  2883. fFormat := tfRGB10X2ui1;
  2884. fWithAlpha := tfRGB10A2ui1;
  2885. fWithoutAlpha := tfRGB10X2ui1;
  2886. fRGBInverted := tfBGR10X2ui1;
  2887. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2888. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2889. {$IFNDEF OPENGL_ES}
  2890. fOpenGLFormat := tfRGB10X2ui1;
  2891. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2892. fglInternalFormat := GL_RGB10;
  2893. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2894. {$ELSE}
  2895. fOpenGLFormat := tfRGB16us3;
  2896. {$ENDIF}
  2897. end;
  2898. procedure TfdX2RGB10ui1.SetValues;
  2899. begin
  2900. inherited SetValues;
  2901. fBitsPerPixel := 32;
  2902. fFormat := tfX2RGB10ui1;
  2903. fWithAlpha := tfA2RGB10ui1;
  2904. fWithoutAlpha := tfX2RGB10ui1;
  2905. fRGBInverted := tfX2BGR10ui1;
  2906. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2907. fShift := glBitmapRec4ub(20, 10, 0, 0);
  2908. {$IFNDEF OPENGL_ES}
  2909. fOpenGLFormat := tfX2RGB10ui1;
  2910. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2911. fglInternalFormat := GL_RGB10;
  2912. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2913. {$ELSE}
  2914. fOpenGLFormat := tfRGB16us3;
  2915. {$ENDIF}
  2916. end;
  2917. procedure TfdRGB16us3.SetValues;
  2918. begin
  2919. inherited SetValues;
  2920. fBitsPerPixel := 48;
  2921. fFormat := tfRGB16us3;
  2922. fWithAlpha := tfRGBA16us4;
  2923. fWithoutAlpha := tfRGB16us3;
  2924. fRGBInverted := tfBGR16us3;
  2925. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2926. fShift := glBitmapRec4ub( 0, 16, 32, 0);
  2927. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2928. fOpenGLFormat := tfRGB16us3;
  2929. fglFormat := GL_RGB;
  2930. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
  2931. fglDataFormat := GL_UNSIGNED_SHORT;
  2932. {$ELSE}
  2933. fOpenGLFormat := tfRGB8ub3;
  2934. {$IFEND}
  2935. end;
  2936. procedure TfdRGBA4us1.SetValues;
  2937. begin
  2938. inherited SetValues;
  2939. fBitsPerPixel := 16;
  2940. fFormat := tfRGBA4us1;
  2941. fWithAlpha := tfRGBA4us1;
  2942. fWithoutAlpha := tfRGBX4us1;
  2943. fOpenGLFormat := tfRGBA4us1;
  2944. fRGBInverted := tfBGRA4us1;
  2945. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2946. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2947. fglFormat := GL_RGBA;
  2948. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2949. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2950. end;
  2951. procedure TfdARGB4us1.SetValues;
  2952. begin
  2953. inherited SetValues;
  2954. fBitsPerPixel := 16;
  2955. fFormat := tfARGB4us1;
  2956. fWithAlpha := tfARGB4us1;
  2957. fWithoutAlpha := tfXRGB4us1;
  2958. fRGBInverted := tfABGR4us1;
  2959. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2960. fShift := glBitmapRec4ub( 8, 4, 0, 12);
  2961. {$IFNDEF OPENGL_ES}
  2962. fOpenGLFormat := tfARGB4us1;
  2963. fglFormat := GL_BGRA;
  2964. fglInternalFormat := GL_RGBA4;
  2965. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2966. {$ELSE}
  2967. fOpenGLFormat := tfRGBA4us1;
  2968. {$ENDIF}
  2969. end;
  2970. procedure TfdRGB5A1us1.SetValues;
  2971. begin
  2972. inherited SetValues;
  2973. fBitsPerPixel := 16;
  2974. fFormat := tfRGB5A1us1;
  2975. fWithAlpha := tfRGB5A1us1;
  2976. fWithoutAlpha := tfRGB5X1us1;
  2977. fOpenGLFormat := tfRGB5A1us1;
  2978. fRGBInverted := tfBGR5A1us1;
  2979. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2980. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2981. fglFormat := GL_RGBA;
  2982. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
  2983. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2984. end;
  2985. procedure TfdA1RGB5us1.SetValues;
  2986. begin
  2987. inherited SetValues;
  2988. fBitsPerPixel := 16;
  2989. fFormat := tfA1RGB5us1;
  2990. fWithAlpha := tfA1RGB5us1;
  2991. fWithoutAlpha := tfX1RGB5us1;
  2992. fRGBInverted := tfA1BGR5us1;
  2993. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2994. fShift := glBitmapRec4ub(10, 5, 0, 15);
  2995. {$IFNDEF OPENGL_ES}
  2996. fOpenGLFormat := tfA1RGB5us1;
  2997. fglFormat := GL_BGRA;
  2998. fglInternalFormat := GL_RGB5_A1;
  2999. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3000. {$ELSE}
  3001. fOpenGLFormat := tfRGB5A1us1;
  3002. {$ENDIF}
  3003. end;
  3004. procedure TfdRGBA8ui1.SetValues;
  3005. begin
  3006. inherited SetValues;
  3007. fBitsPerPixel := 32;
  3008. fFormat := tfRGBA8ui1;
  3009. fWithAlpha := tfRGBA8ui1;
  3010. fWithoutAlpha := tfRGBX8ui1;
  3011. fRGBInverted := tfBGRA8ui1;
  3012. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3013. fShift := glBitmapRec4ub(24, 16, 8, 0);
  3014. {$IFNDEF OPENGL_ES}
  3015. fOpenGLFormat := tfRGBA8ui1;
  3016. fglFormat := GL_RGBA;
  3017. fglInternalFormat := GL_RGBA8;
  3018. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3019. {$ELSE}
  3020. fOpenGLFormat := tfRGBA8ub4;
  3021. {$ENDIF}
  3022. end;
  3023. procedure TfdARGB8ui1.SetValues;
  3024. begin
  3025. inherited SetValues;
  3026. fBitsPerPixel := 32;
  3027. fFormat := tfARGB8ui1;
  3028. fWithAlpha := tfARGB8ui1;
  3029. fWithoutAlpha := tfXRGB8ui1;
  3030. fRGBInverted := tfABGR8ui1;
  3031. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3032. fShift := glBitmapRec4ub(16, 8, 0, 24);
  3033. {$IFNDEF OPENGL_ES}
  3034. fOpenGLFormat := tfARGB8ui1;
  3035. fglFormat := GL_BGRA;
  3036. fglInternalFormat := GL_RGBA8;
  3037. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3038. {$ELSE}
  3039. fOpenGLFormat := tfRGBA8ub4;
  3040. {$ENDIF}
  3041. end;
  3042. procedure TfdRGBA8ub4.SetValues;
  3043. begin
  3044. inherited SetValues;
  3045. fBitsPerPixel := 32;
  3046. fFormat := tfRGBA8ub4;
  3047. fWithAlpha := tfRGBA8ub4;
  3048. fWithoutAlpha := tfRGB8ub3;
  3049. fOpenGLFormat := tfRGBA8ub4;
  3050. fRGBInverted := tfBGRA8ub4;
  3051. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3052. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  3053. fglFormat := GL_RGBA;
  3054. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  3055. fglDataFormat := GL_UNSIGNED_BYTE;
  3056. end;
  3057. procedure TfdRGB10A2ui1.SetValues;
  3058. begin
  3059. inherited SetValues;
  3060. fBitsPerPixel := 32;
  3061. fFormat := tfRGB10A2ui1;
  3062. fWithAlpha := tfRGB10A2ui1;
  3063. fWithoutAlpha := tfRGB10X2ui1;
  3064. fRGBInverted := tfBGR10A2ui1;
  3065. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3066. fShift := glBitmapRec4ub(22, 12, 2, 0);
  3067. {$IFNDEF OPENGL_ES}
  3068. fOpenGLFormat := tfRGB10A2ui1;
  3069. fglFormat := GL_RGBA;
  3070. fglInternalFormat := GL_RGB10_A2;
  3071. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3072. {$ELSE}
  3073. fOpenGLFormat := tfA2RGB10ui1;
  3074. {$ENDIF}
  3075. end;
  3076. procedure TfdA2RGB10ui1.SetValues;
  3077. begin
  3078. inherited SetValues;
  3079. fBitsPerPixel := 32;
  3080. fFormat := tfA2RGB10ui1;
  3081. fWithAlpha := tfA2RGB10ui1;
  3082. fWithoutAlpha := tfX2RGB10ui1;
  3083. fRGBInverted := tfA2BGR10ui1;
  3084. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3085. fShift := glBitmapRec4ub(20, 10, 0, 30);
  3086. {$IF NOT DEFINED(OPENGL_ES)}
  3087. fOpenGLFormat := tfA2RGB10ui1;
  3088. fglFormat := GL_BGRA;
  3089. fglInternalFormat := GL_RGB10_A2;
  3090. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3091. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  3092. fOpenGLFormat := tfA2RGB10ui1;
  3093. fglFormat := GL_RGBA;
  3094. fglInternalFormat := GL_RGB10_A2;
  3095. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3096. {$ELSE}
  3097. fOpenGLFormat := tfRGBA8ui1;
  3098. {$IFEND}
  3099. end;
  3100. procedure TfdRGBA16us4.SetValues;
  3101. begin
  3102. inherited SetValues;
  3103. fBitsPerPixel := 64;
  3104. fFormat := tfRGBA16us4;
  3105. fWithAlpha := tfRGBA16us4;
  3106. fWithoutAlpha := tfRGB16us3;
  3107. fRGBInverted := tfBGRA16us4;
  3108. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3109. fShift := glBitmapRec4ub( 0, 16, 32, 48);
  3110. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  3111. fOpenGLFormat := tfRGBA16us4;
  3112. fglFormat := GL_RGBA;
  3113. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
  3114. fglDataFormat := GL_UNSIGNED_SHORT;
  3115. {$ELSE}
  3116. fOpenGLFormat := tfRGBA8ub4;
  3117. {$IFEND}
  3118. end;
  3119. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3120. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3121. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3122. procedure TfdBGRX4us1.SetValues;
  3123. begin
  3124. inherited SetValues;
  3125. fBitsPerPixel := 16;
  3126. fFormat := tfBGRX4us1;
  3127. fWithAlpha := tfBGRA4us1;
  3128. fWithoutAlpha := tfBGRX4us1;
  3129. fRGBInverted := tfRGBX4us1;
  3130. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  3131. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  3132. {$IFNDEF OPENGL_ES}
  3133. fOpenGLFormat := tfBGRX4us1;
  3134. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3135. fglInternalFormat := GL_RGB4;
  3136. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3137. {$ELSE}
  3138. fOpenGLFormat := tfR5G6B5us1;
  3139. {$ENDIF}
  3140. end;
  3141. procedure TfdXBGR4us1.SetValues;
  3142. begin
  3143. inherited SetValues;
  3144. fBitsPerPixel := 16;
  3145. fFormat := tfXBGR4us1;
  3146. fWithAlpha := tfABGR4us1;
  3147. fWithoutAlpha := tfXBGR4us1;
  3148. fRGBInverted := tfXRGB4us1;
  3149. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  3150. fShift := glBitmapRec4ub( 0, 4, 8, 0);
  3151. {$IFNDEF OPENGL_ES}
  3152. fOpenGLFormat := tfXBGR4us1;
  3153. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3154. fglInternalFormat := GL_RGB4;
  3155. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3156. {$ELSE}
  3157. fOpenGLFormat := tfR5G6B5us1;
  3158. {$ENDIF}
  3159. end;
  3160. procedure TfdB5G6R5us1.SetValues;
  3161. begin
  3162. inherited SetValues;
  3163. fBitsPerPixel := 16;
  3164. fFormat := tfB5G6R5us1;
  3165. fWithAlpha := tfBGR5A1us1;
  3166. fWithoutAlpha := tfB5G6R5us1;
  3167. fRGBInverted := tfR5G6B5us1;
  3168. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  3169. fShift := glBitmapRec4ub( 0, 5, 11, 0);
  3170. {$IFNDEF OPENGL_ES}
  3171. fOpenGLFormat := tfB5G6R5us1;
  3172. fglFormat := GL_RGB;
  3173. fglInternalFormat := GL_RGB565;
  3174. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  3175. {$ELSE}
  3176. fOpenGLFormat := tfR5G6B5us1;
  3177. {$ENDIF}
  3178. end;
  3179. procedure TfdBGR5X1us1.SetValues;
  3180. begin
  3181. inherited SetValues;
  3182. fBitsPerPixel := 16;
  3183. fFormat := tfBGR5X1us1;
  3184. fWithAlpha := tfBGR5A1us1;
  3185. fWithoutAlpha := tfBGR5X1us1;
  3186. fRGBInverted := tfRGB5X1us1;
  3187. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  3188. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  3189. {$IFNDEF OPENGL_ES}
  3190. fOpenGLFormat := tfBGR5X1us1;
  3191. fglFormat := GL_BGRA;
  3192. fglInternalFormat := GL_RGB5;
  3193. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3194. {$ELSE}
  3195. fOpenGLFormat := tfR5G6B5us1;
  3196. {$ENDIF}
  3197. end;
  3198. procedure TfdX1BGR5us1.SetValues;
  3199. begin
  3200. inherited SetValues;
  3201. fBitsPerPixel := 16;
  3202. fFormat := tfX1BGR5us1;
  3203. fWithAlpha := tfA1BGR5us1;
  3204. fWithoutAlpha := tfX1BGR5us1;
  3205. fRGBInverted := tfX1RGB5us1;
  3206. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  3207. fShift := glBitmapRec4ub( 0, 5, 10, 0);
  3208. {$IFNDEF OPENGL_ES}
  3209. fOpenGLFormat := tfX1BGR5us1;
  3210. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3211. fglInternalFormat := GL_RGB5;
  3212. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3213. {$ELSE}
  3214. fOpenGLFormat := tfR5G6B5us1;
  3215. {$ENDIF}
  3216. end;
  3217. procedure TfdBGR8ub3.SetValues;
  3218. begin
  3219. inherited SetValues;
  3220. fBitsPerPixel := 24;
  3221. fFormat := tfBGR8ub3;
  3222. fWithAlpha := tfBGRA8ub4;
  3223. fWithoutAlpha := tfBGR8ub3;
  3224. fRGBInverted := tfRGB8ub3;
  3225. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  3226. fShift := glBitmapRec4ub(16, 8, 0, 0);
  3227. {$IFNDEF OPENGL_ES}
  3228. fOpenGLFormat := tfBGR8ub3;
  3229. fglFormat := GL_BGR;
  3230. fglInternalFormat := GL_RGB8;
  3231. fglDataFormat := GL_UNSIGNED_BYTE;
  3232. {$ELSE}
  3233. fOpenGLFormat := tfRGB8ub3;
  3234. {$ENDIF}
  3235. end;
  3236. procedure TfdBGRX8ui1.SetValues;
  3237. begin
  3238. inherited SetValues;
  3239. fBitsPerPixel := 32;
  3240. fFormat := tfBGRX8ui1;
  3241. fWithAlpha := tfBGRA8ui1;
  3242. fWithoutAlpha := tfBGRX8ui1;
  3243. fRGBInverted := tfRGBX8ui1;
  3244. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  3245. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  3246. {$IFNDEF OPENGL_ES}
  3247. fOpenGLFormat := tfBGRX8ui1;
  3248. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3249. fglInternalFormat := GL_RGB8;
  3250. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3251. {$ELSE}
  3252. fOpenGLFormat := tfRGB8ub3;
  3253. {$ENDIF}
  3254. end;
  3255. procedure TfdXBGR8ui1.SetValues;
  3256. begin
  3257. inherited SetValues;
  3258. fBitsPerPixel := 32;
  3259. fFormat := tfXBGR8ui1;
  3260. fWithAlpha := tfABGR8ui1;
  3261. fWithoutAlpha := tfXBGR8ui1;
  3262. fRGBInverted := tfXRGB8ui1;
  3263. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  3264. fShift := glBitmapRec4ub( 0, 8, 16, 0);
  3265. {$IFNDEF OPENGL_ES}
  3266. fOpenGLFormat := tfXBGR8ui1;
  3267. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3268. fglInternalFormat := GL_RGB8;
  3269. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3270. {$ELSE}
  3271. fOpenGLFormat := tfRGB8ub3;
  3272. {$ENDIF}
  3273. end;
  3274. procedure TfdBGR10X2ui1.SetValues;
  3275. begin
  3276. inherited SetValues;
  3277. fBitsPerPixel := 32;
  3278. fFormat := tfBGR10X2ui1;
  3279. fWithAlpha := tfBGR10A2ui1;
  3280. fWithoutAlpha := tfBGR10X2ui1;
  3281. fRGBInverted := tfRGB10X2ui1;
  3282. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  3283. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  3284. {$IFNDEF OPENGL_ES}
  3285. fOpenGLFormat := tfBGR10X2ui1;
  3286. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3287. fglInternalFormat := GL_RGB10;
  3288. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3289. {$ELSE}
  3290. fOpenGLFormat := tfRGB16us3;
  3291. {$ENDIF}
  3292. end;
  3293. procedure TfdX2BGR10ui1.SetValues;
  3294. begin
  3295. inherited SetValues;
  3296. fBitsPerPixel := 32;
  3297. fFormat := tfX2BGR10ui1;
  3298. fWithAlpha := tfA2BGR10ui1;
  3299. fWithoutAlpha := tfX2BGR10ui1;
  3300. fRGBInverted := tfX2RGB10ui1;
  3301. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  3302. fShift := glBitmapRec4ub( 0, 10, 20, 0);
  3303. {$IFNDEF OPENGL_ES}
  3304. fOpenGLFormat := tfX2BGR10ui1;
  3305. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3306. fglInternalFormat := GL_RGB10;
  3307. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3308. {$ELSE}
  3309. fOpenGLFormat := tfRGB16us3;
  3310. {$ENDIF}
  3311. end;
  3312. procedure TfdBGR16us3.SetValues;
  3313. begin
  3314. inherited SetValues;
  3315. fBitsPerPixel := 48;
  3316. fFormat := tfBGR16us3;
  3317. fWithAlpha := tfBGRA16us4;
  3318. fWithoutAlpha := tfBGR16us3;
  3319. fRGBInverted := tfRGB16us3;
  3320. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  3321. fShift := glBitmapRec4ub(32, 16, 0, 0);
  3322. {$IFNDEF OPENGL_ES}
  3323. fOpenGLFormat := tfBGR16us3;
  3324. fglFormat := GL_BGR;
  3325. fglInternalFormat := GL_RGB16;
  3326. fglDataFormat := GL_UNSIGNED_SHORT;
  3327. {$ELSE}
  3328. fOpenGLFormat := tfRGB16us3;
  3329. {$ENDIF}
  3330. end;
  3331. procedure TfdBGRA4us1.SetValues;
  3332. begin
  3333. inherited SetValues;
  3334. fBitsPerPixel := 16;
  3335. fFormat := tfBGRA4us1;
  3336. fWithAlpha := tfBGRA4us1;
  3337. fWithoutAlpha := tfBGRX4us1;
  3338. fRGBInverted := tfRGBA4us1;
  3339. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3340. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  3341. {$IFNDEF OPENGL_ES}
  3342. fOpenGLFormat := tfBGRA4us1;
  3343. fglFormat := GL_BGRA;
  3344. fglInternalFormat := GL_RGBA4;
  3345. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3346. {$ELSE}
  3347. fOpenGLFormat := tfRGBA4us1;
  3348. {$ENDIF}
  3349. end;
  3350. procedure TfdABGR4us1.SetValues;
  3351. begin
  3352. inherited SetValues;
  3353. fBitsPerPixel := 16;
  3354. fFormat := tfABGR4us1;
  3355. fWithAlpha := tfABGR4us1;
  3356. fWithoutAlpha := tfXBGR4us1;
  3357. fRGBInverted := tfARGB4us1;
  3358. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3359. fShift := glBitmapRec4ub( 0, 4, 8, 12);
  3360. {$IFNDEF OPENGL_ES}
  3361. fOpenGLFormat := tfABGR4us1;
  3362. fglFormat := GL_RGBA;
  3363. fglInternalFormat := GL_RGBA4;
  3364. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3365. {$ELSE}
  3366. fOpenGLFormat := tfRGBA4us1;
  3367. {$ENDIF}
  3368. end;
  3369. procedure TfdBGR5A1us1.SetValues;
  3370. begin
  3371. inherited SetValues;
  3372. fBitsPerPixel := 16;
  3373. fFormat := tfBGR5A1us1;
  3374. fWithAlpha := tfBGR5A1us1;
  3375. fWithoutAlpha := tfBGR5X1us1;
  3376. fRGBInverted := tfRGB5A1us1;
  3377. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3378. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  3379. {$IFNDEF OPENGL_ES}
  3380. fOpenGLFormat := tfBGR5A1us1;
  3381. fglFormat := GL_BGRA;
  3382. fglInternalFormat := GL_RGB5_A1;
  3383. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3384. {$ELSE}
  3385. fOpenGLFormat := tfRGB5A1us1;
  3386. {$ENDIF}
  3387. end;
  3388. procedure TfdA1BGR5us1.SetValues;
  3389. begin
  3390. inherited SetValues;
  3391. fBitsPerPixel := 16;
  3392. fFormat := tfA1BGR5us1;
  3393. fWithAlpha := tfA1BGR5us1;
  3394. fWithoutAlpha := tfX1BGR5us1;
  3395. fRGBInverted := tfA1RGB5us1;
  3396. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3397. fShift := glBitmapRec4ub( 0, 5, 10, 15);
  3398. {$IFNDEF OPENGL_ES}
  3399. fOpenGLFormat := tfA1BGR5us1;
  3400. fglFormat := GL_RGBA;
  3401. fglInternalFormat := GL_RGB5_A1;
  3402. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3403. {$ELSE}
  3404. fOpenGLFormat := tfRGB5A1us1;
  3405. {$ENDIF}
  3406. end;
  3407. procedure TfdBGRA8ui1.SetValues;
  3408. begin
  3409. inherited SetValues;
  3410. fBitsPerPixel := 32;
  3411. fFormat := tfBGRA8ui1;
  3412. fWithAlpha := tfBGRA8ui1;
  3413. fWithoutAlpha := tfBGRX8ui1;
  3414. fRGBInverted := tfRGBA8ui1;
  3415. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3416. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  3417. {$IFNDEF OPENGL_ES}
  3418. fOpenGLFormat := tfBGRA8ui1;
  3419. fglFormat := GL_BGRA;
  3420. fglInternalFormat := GL_RGBA8;
  3421. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3422. {$ELSE}
  3423. fOpenGLFormat := tfRGBA8ub4;
  3424. {$ENDIF}
  3425. end;
  3426. procedure TfdABGR8ui1.SetValues;
  3427. begin
  3428. inherited SetValues;
  3429. fBitsPerPixel := 32;
  3430. fFormat := tfABGR8ui1;
  3431. fWithAlpha := tfABGR8ui1;
  3432. fWithoutAlpha := tfXBGR8ui1;
  3433. fRGBInverted := tfARGB8ui1;
  3434. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3435. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  3436. {$IFNDEF OPENGL_ES}
  3437. fOpenGLFormat := tfABGR8ui1;
  3438. fglFormat := GL_RGBA;
  3439. fglInternalFormat := GL_RGBA8;
  3440. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3441. {$ELSE}
  3442. fOpenGLFormat := tfRGBA8ub4
  3443. {$ENDIF}
  3444. end;
  3445. procedure TfdBGRA8ub4.SetValues;
  3446. begin
  3447. inherited SetValues;
  3448. fBitsPerPixel := 32;
  3449. fFormat := tfBGRA8ub4;
  3450. fWithAlpha := tfBGRA8ub4;
  3451. fWithoutAlpha := tfBGR8ub3;
  3452. fRGBInverted := tfRGBA8ub4;
  3453. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3454. fShift := glBitmapRec4ub(16, 8, 0, 24);
  3455. {$IFNDEF OPENGL_ES}
  3456. fOpenGLFormat := tfBGRA8ub4;
  3457. fglFormat := GL_BGRA;
  3458. fglInternalFormat := GL_RGBA8;
  3459. fglDataFormat := GL_UNSIGNED_BYTE;
  3460. {$ELSE}
  3461. fOpenGLFormat := tfRGBA8ub4;
  3462. {$ENDIF}
  3463. end;
  3464. procedure TfdBGR10A2ui1.SetValues;
  3465. begin
  3466. inherited SetValues;
  3467. fBitsPerPixel := 32;
  3468. fFormat := tfBGR10A2ui1;
  3469. fWithAlpha := tfBGR10A2ui1;
  3470. fWithoutAlpha := tfBGR10X2ui1;
  3471. fRGBInverted := tfRGB10A2ui1;
  3472. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3473. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  3474. {$IFNDEF OPENGL_ES}
  3475. fOpenGLFormat := tfBGR10A2ui1;
  3476. fglFormat := GL_BGRA;
  3477. fglInternalFormat := GL_RGB10_A2;
  3478. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3479. {$ELSE}
  3480. fOpenGLFormat := tfA2RGB10ui1;
  3481. {$ENDIF}
  3482. end;
  3483. procedure TfdA2BGR10ui1.SetValues;
  3484. begin
  3485. inherited SetValues;
  3486. fBitsPerPixel := 32;
  3487. fFormat := tfA2BGR10ui1;
  3488. fWithAlpha := tfA2BGR10ui1;
  3489. fWithoutAlpha := tfX2BGR10ui1;
  3490. fRGBInverted := tfA2RGB10ui1;
  3491. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3492. fShift := glBitmapRec4ub( 0, 10, 20, 30);
  3493. {$IFNDEF OPENGL_ES}
  3494. fOpenGLFormat := tfA2BGR10ui1;
  3495. fglFormat := GL_RGBA;
  3496. fglInternalFormat := GL_RGB10_A2;
  3497. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3498. {$ELSE}
  3499. fOpenGLFormat := tfA2RGB10ui1;
  3500. {$ENDIF}
  3501. end;
  3502. procedure TfdBGRA16us4.SetValues;
  3503. begin
  3504. inherited SetValues;
  3505. fBitsPerPixel := 64;
  3506. fFormat := tfBGRA16us4;
  3507. fWithAlpha := tfBGRA16us4;
  3508. fWithoutAlpha := tfBGR16us3;
  3509. fRGBInverted := tfRGBA16us4;
  3510. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3511. fShift := glBitmapRec4ub(32, 16, 0, 48);
  3512. {$IFNDEF OPENGL_ES}
  3513. fOpenGLFormat := tfBGRA16us4;
  3514. fglFormat := GL_BGRA;
  3515. fglInternalFormat := GL_RGBA16;
  3516. fglDataFormat := GL_UNSIGNED_SHORT;
  3517. {$ELSE}
  3518. fOpenGLFormat := tfRGBA16us4;
  3519. {$ENDIF}
  3520. end;
  3521. procedure TfdDepth16us1.SetValues;
  3522. begin
  3523. inherited SetValues;
  3524. fBitsPerPixel := 16;
  3525. fFormat := tfDepth16us1;
  3526. fWithoutAlpha := tfDepth16us1;
  3527. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3528. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3529. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  3530. fOpenGLFormat := tfDepth16us1;
  3531. fglFormat := GL_DEPTH_COMPONENT;
  3532. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3533. fglDataFormat := GL_UNSIGNED_SHORT;
  3534. {$IFEND}
  3535. end;
  3536. procedure TfdDepth24ui1.SetValues;
  3537. begin
  3538. inherited SetValues;
  3539. fBitsPerPixel := 32;
  3540. fFormat := tfDepth24ui1;
  3541. fWithoutAlpha := tfDepth24ui1;
  3542. fOpenGLFormat := tfDepth24ui1;
  3543. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3544. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3545. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  3546. fOpenGLFormat := tfDepth24ui1;
  3547. fglFormat := GL_DEPTH_COMPONENT;
  3548. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3549. fglDataFormat := GL_UNSIGNED_INT;
  3550. {$IFEND}
  3551. end;
  3552. procedure TfdDepth32ui1.SetValues;
  3553. begin
  3554. inherited SetValues;
  3555. fBitsPerPixel := 32;
  3556. fFormat := tfDepth32ui1;
  3557. fWithoutAlpha := tfDepth32ui1;
  3558. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3559. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3560. {$IF NOT DEFINED(OPENGL_ES)}
  3561. fOpenGLFormat := tfDepth32ui1;
  3562. fglFormat := GL_DEPTH_COMPONENT;
  3563. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3564. fglDataFormat := GL_UNSIGNED_INT;
  3565. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  3566. fOpenGLFormat := tfDepth24ui1;
  3567. {$ELSEIF DEFINED(OPENGL_ES_2_0)}
  3568. fOpenGLFormat := tfDepth16us1;
  3569. {$IFEND}
  3570. end;
  3571. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3572. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3574. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3575. begin
  3576. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3577. end;
  3578. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3579. begin
  3580. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3581. end;
  3582. procedure TfdS3tcDtx1RGBA.SetValues;
  3583. begin
  3584. inherited SetValues;
  3585. fFormat := tfS3tcDtx1RGBA;
  3586. fWithAlpha := tfS3tcDtx1RGBA;
  3587. fUncompressed := tfRGB5A1us1;
  3588. fBitsPerPixel := 4;
  3589. fIsCompressed := true;
  3590. {$IFNDEF OPENGL_ES}
  3591. fOpenGLFormat := tfS3tcDtx1RGBA;
  3592. fglFormat := GL_COMPRESSED_RGBA;
  3593. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3594. fglDataFormat := GL_UNSIGNED_BYTE;
  3595. {$ELSE}
  3596. fOpenGLFormat := fUncompressed;
  3597. {$ENDIF}
  3598. end;
  3599. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3600. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3601. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3602. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3603. begin
  3604. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3605. end;
  3606. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3607. begin
  3608. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3609. end;
  3610. procedure TfdS3tcDtx3RGBA.SetValues;
  3611. begin
  3612. inherited SetValues;
  3613. fFormat := tfS3tcDtx3RGBA;
  3614. fWithAlpha := tfS3tcDtx3RGBA;
  3615. fUncompressed := tfRGBA8ub4;
  3616. fBitsPerPixel := 8;
  3617. fIsCompressed := true;
  3618. {$IFNDEF OPENGL_ES}
  3619. fOpenGLFormat := tfS3tcDtx3RGBA;
  3620. fglFormat := GL_COMPRESSED_RGBA;
  3621. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3622. fglDataFormat := GL_UNSIGNED_BYTE;
  3623. {$ELSE}
  3624. fOpenGLFormat := fUncompressed;
  3625. {$ENDIF}
  3626. end;
  3627. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3628. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3629. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3630. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3631. begin
  3632. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3633. end;
  3634. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3635. begin
  3636. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3637. end;
  3638. procedure TfdS3tcDtx5RGBA.SetValues;
  3639. begin
  3640. inherited SetValues;
  3641. fFormat := tfS3tcDtx3RGBA;
  3642. fWithAlpha := tfS3tcDtx3RGBA;
  3643. fUncompressed := tfRGBA8ub4;
  3644. fBitsPerPixel := 8;
  3645. fIsCompressed := true;
  3646. {$IFNDEF OPENGL_ES}
  3647. fOpenGLFormat := tfS3tcDtx3RGBA;
  3648. fglFormat := GL_COMPRESSED_RGBA;
  3649. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3650. fglDataFormat := GL_UNSIGNED_BYTE;
  3651. {$ELSE}
  3652. fOpenGLFormat := fUncompressed;
  3653. {$ENDIF}
  3654. end;
  3655. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3656. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3657. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3658. function TglBitmapFormatDescriptor.GetHasRed: Boolean;
  3659. begin
  3660. result := (fPrecision.r > 0);
  3661. end;
  3662. function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
  3663. begin
  3664. result := (fPrecision.g > 0);
  3665. end;
  3666. function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
  3667. begin
  3668. result := (fPrecision.b > 0);
  3669. end;
  3670. function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
  3671. begin
  3672. result := (fPrecision.a > 0);
  3673. end;
  3674. function TglBitmapFormatDescriptor.GetHasColor: Boolean;
  3675. begin
  3676. result := HasRed or HasGreen or HasBlue;
  3677. end;
  3678. function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
  3679. begin
  3680. result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
  3681. end;
  3682. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3683. procedure TglBitmapFormatDescriptor.SetValues;
  3684. begin
  3685. fFormat := tfEmpty;
  3686. fWithAlpha := tfEmpty;
  3687. fWithoutAlpha := tfEmpty;
  3688. fOpenGLFormat := tfEmpty;
  3689. fRGBInverted := tfEmpty;
  3690. fUncompressed := tfEmpty;
  3691. fBitsPerPixel := 0;
  3692. fIsCompressed := false;
  3693. fglFormat := 0;
  3694. fglInternalFormat := 0;
  3695. fglDataFormat := 0;
  3696. FillChar(fPrecision, 0, SizeOf(fPrecision));
  3697. FillChar(fShift, 0, SizeOf(fShift));
  3698. end;
  3699. procedure TglBitmapFormatDescriptor.CalcValues;
  3700. var
  3701. i: Integer;
  3702. begin
  3703. fBytesPerPixel := fBitsPerPixel / 8;
  3704. fChannelCount := 0;
  3705. for i := 0 to 3 do begin
  3706. if (fPrecision.arr[i] > 0) then
  3707. inc(fChannelCount);
  3708. fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
  3709. fMask.arr[i] := fRange.arr[i] shl fShift.arr[i];
  3710. end;
  3711. end;
  3712. constructor TglBitmapFormatDescriptor.Create;
  3713. begin
  3714. inherited Create;
  3715. SetValues;
  3716. CalcValues;
  3717. end;
  3718. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3719. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3720. var
  3721. f: TglBitmapFormat;
  3722. begin
  3723. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3724. result := TFormatDescriptor.Get(f);
  3725. if (result.glInternalFormat = aInternalFormat) then
  3726. exit;
  3727. end;
  3728. result := TFormatDescriptor.Get(tfEmpty);
  3729. end;
  3730. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3731. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3733. class procedure TFormatDescriptor.Init;
  3734. begin
  3735. if not Assigned(FormatDescriptorCS) then
  3736. FormatDescriptorCS := TCriticalSection.Create;
  3737. end;
  3738. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3739. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3740. begin
  3741. FormatDescriptorCS.Enter;
  3742. try
  3743. result := FormatDescriptors[aFormat];
  3744. if not Assigned(result) then begin
  3745. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3746. FormatDescriptors[aFormat] := result;
  3747. end;
  3748. finally
  3749. FormatDescriptorCS.Leave;
  3750. end;
  3751. end;
  3752. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3753. class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3754. begin
  3755. result := Get(Get(aFormat).WithAlpha);
  3756. end;
  3757. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3758. class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
  3759. var
  3760. ft: TglBitmapFormat;
  3761. begin
  3762. // find matching format with OpenGL support
  3763. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3764. result := Get(ft);
  3765. if (result.MaskMatch(aMask)) and
  3766. (result.glFormat <> 0) and
  3767. (result.glInternalFormat <> 0) and
  3768. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3769. then
  3770. exit;
  3771. end;
  3772. // find matching format without OpenGL Support
  3773. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3774. result := Get(ft);
  3775. if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3776. exit;
  3777. end;
  3778. result := TFormatDescriptor.Get(tfEmpty);
  3779. end;
  3780. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3781. class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  3782. var
  3783. ft: TglBitmapFormat;
  3784. begin
  3785. // find matching format with OpenGL support
  3786. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3787. result := Get(ft);
  3788. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3789. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3790. (result.glFormat <> 0) and
  3791. (result.glInternalFormat <> 0) and
  3792. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3793. then
  3794. exit;
  3795. end;
  3796. // find matching format without OpenGL Support
  3797. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3798. result := Get(ft);
  3799. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3800. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3801. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3802. exit;
  3803. end;
  3804. result := TFormatDescriptor.Get(tfEmpty);
  3805. end;
  3806. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3807. class procedure TFormatDescriptor.Clear;
  3808. var
  3809. f: TglBitmapFormat;
  3810. begin
  3811. FormatDescriptorCS.Enter;
  3812. try
  3813. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3814. FreeAndNil(FormatDescriptors[f]);
  3815. finally
  3816. FormatDescriptorCS.Leave;
  3817. end;
  3818. end;
  3819. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3820. class procedure TFormatDescriptor.Finalize;
  3821. begin
  3822. Clear;
  3823. FreeAndNil(FormatDescriptorCS);
  3824. end;
  3825. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3826. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3827. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3828. procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
  3829. var
  3830. i: Integer;
  3831. begin
  3832. for i := 0 to 3 do begin
  3833. fShift.arr[i] := 0;
  3834. while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin
  3835. aMask.arr[i] := aMask.arr[i] shr 1;
  3836. inc(fShift.arr[i]);
  3837. end;
  3838. fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
  3839. end;
  3840. CalcValues;
  3841. end;
  3842. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3843. procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3844. begin
  3845. fBitsPerPixel := aBBP;
  3846. fPrecision := aPrec;
  3847. fShift := aShift;
  3848. CalcValues;
  3849. end;
  3850. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3851. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3852. var
  3853. data: QWord;
  3854. begin
  3855. data :=
  3856. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3857. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3858. ((aPixel.Data.b and Range.b) shl Shift.b) or
  3859. ((aPixel.Data.a and Range.a) shl Shift.a);
  3860. case BitsPerPixel of
  3861. 8: aData^ := data;
  3862. 16: PWord(aData)^ := data;
  3863. 32: PCardinal(aData)^ := data;
  3864. 64: PQWord(aData)^ := data;
  3865. else
  3866. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3867. end;
  3868. inc(aData, Round(BytesPerPixel));
  3869. end;
  3870. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3871. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3872. var
  3873. data: QWord;
  3874. i: Integer;
  3875. begin
  3876. case BitsPerPixel of
  3877. 8: data := aData^;
  3878. 16: data := PWord(aData)^;
  3879. 32: data := PCardinal(aData)^;
  3880. 64: data := PQWord(aData)^;
  3881. else
  3882. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3883. end;
  3884. for i := 0 to 3 do
  3885. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
  3886. inc(aData, Round(BytesPerPixel));
  3887. end;
  3888. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3889. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3890. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3891. procedure TbmpColorTableFormat.SetValues;
  3892. begin
  3893. inherited SetValues;
  3894. fShift := glBitmapRec4ub(8, 8, 8, 0);
  3895. end;
  3896. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3897. procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3898. begin
  3899. fFormat := aFormat;
  3900. fBitsPerPixel := aBPP;
  3901. fPrecision := aPrec;
  3902. fShift := aShift;
  3903. CalcValues;
  3904. end;
  3905. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3906. procedure TbmpColorTableFormat.CalcValues;
  3907. begin
  3908. inherited CalcValues;
  3909. end;
  3910. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3911. procedure TbmpColorTableFormat.CreateColorTable;
  3912. var
  3913. i: Integer;
  3914. begin
  3915. SetLength(fColorTable, 256);
  3916. if not HasColor then begin
  3917. // alpha
  3918. for i := 0 to High(fColorTable) do begin
  3919. fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3920. fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3921. fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3922. fColorTable[i].a := 0;
  3923. end;
  3924. end else begin
  3925. // normal
  3926. for i := 0 to High(fColorTable) do begin
  3927. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3928. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3929. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3930. fColorTable[i].a := 0;
  3931. end;
  3932. end;
  3933. end;
  3934. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3935. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3936. begin
  3937. if (BitsPerPixel <> 8) then
  3938. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3939. if not HasColor then
  3940. // alpha
  3941. aData^ := aPixel.Data.a
  3942. else
  3943. // normal
  3944. aData^ := Round(
  3945. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3946. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3947. ((aPixel.Data.b and Range.b) shl Shift.b));
  3948. inc(aData);
  3949. end;
  3950. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3951. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3952. begin
  3953. if (BitsPerPixel <> 8) then
  3954. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3955. with fColorTable[aData^] do begin
  3956. aPixel.Data.r := r;
  3957. aPixel.Data.g := g;
  3958. aPixel.Data.b := b;
  3959. aPixel.Data.a := a;
  3960. end;
  3961. inc(aData, 1);
  3962. end;
  3963. destructor TbmpColorTableFormat.Destroy;
  3964. begin
  3965. SetLength(fColorTable, 0);
  3966. inherited Destroy;
  3967. end;
  3968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3969. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3970. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3971. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3972. var
  3973. i: Integer;
  3974. begin
  3975. for i := 0 to 3 do begin
  3976. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3977. if (aSourceFD.Range.arr[i] > 0) then
  3978. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3979. else
  3980. aPixel.Data.arr[i] := 0;
  3981. end;
  3982. end;
  3983. end;
  3984. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3985. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3986. begin
  3987. with aFuncRec do begin
  3988. if (Source.Range.r > 0) then
  3989. Dest.Data.r := Source.Data.r;
  3990. if (Source.Range.g > 0) then
  3991. Dest.Data.g := Source.Data.g;
  3992. if (Source.Range.b > 0) then
  3993. Dest.Data.b := Source.Data.b;
  3994. if (Source.Range.a > 0) then
  3995. Dest.Data.a := Source.Data.a;
  3996. end;
  3997. end;
  3998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3999. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  4000. var
  4001. i: Integer;
  4002. begin
  4003. with aFuncRec do begin
  4004. for i := 0 to 3 do
  4005. if (Source.Range.arr[i] > 0) then
  4006. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  4007. end;
  4008. end;
  4009. type
  4010. TShiftData = packed record
  4011. case Integer of
  4012. 0: (r, g, b, a: SmallInt);
  4013. 1: (arr: array[0..3] of SmallInt);
  4014. end;
  4015. PShiftData = ^TShiftData;
  4016. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4017. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  4018. var
  4019. i: Integer;
  4020. begin
  4021. with aFuncRec do
  4022. for i := 0 to 3 do
  4023. if (Source.Range.arr[i] > 0) then
  4024. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  4025. end;
  4026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4027. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  4028. begin
  4029. with aFuncRec do begin
  4030. Dest.Data := Source.Data;
  4031. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  4032. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  4033. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  4034. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  4035. end;
  4036. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  4037. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  4038. end;
  4039. end;
  4040. end;
  4041. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4042. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  4043. var
  4044. i: Integer;
  4045. begin
  4046. with aFuncRec do begin
  4047. for i := 0 to 3 do
  4048. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  4049. end;
  4050. end;
  4051. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4052. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  4053. var
  4054. Temp: Single;
  4055. begin
  4056. with FuncRec do begin
  4057. if (FuncRec.Args = nil) then begin //source has no alpha
  4058. Temp :=
  4059. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  4060. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  4061. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  4062. Dest.Data.a := Round(Dest.Range.a * Temp);
  4063. end else
  4064. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  4065. end;
  4066. end;
  4067. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4068. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  4069. type
  4070. PglBitmapPixelData = ^TglBitmapPixelData;
  4071. begin
  4072. with FuncRec do begin
  4073. Dest.Data.r := Source.Data.r;
  4074. Dest.Data.g := Source.Data.g;
  4075. Dest.Data.b := Source.Data.b;
  4076. with PglBitmapPixelData(Args)^ do
  4077. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  4078. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  4079. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  4080. Dest.Data.a := 0
  4081. else
  4082. Dest.Data.a := Dest.Range.a;
  4083. end;
  4084. end;
  4085. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4086. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  4087. begin
  4088. with FuncRec do begin
  4089. Dest.Data.r := Source.Data.r;
  4090. Dest.Data.g := Source.Data.g;
  4091. Dest.Data.b := Source.Data.b;
  4092. Dest.Data.a := PCardinal(Args)^;
  4093. end;
  4094. end;
  4095. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4096. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  4097. type
  4098. PRGBPix = ^TRGBPix;
  4099. TRGBPix = array [0..2] of byte;
  4100. var
  4101. Temp: Byte;
  4102. begin
  4103. while aWidth > 0 do begin
  4104. Temp := PRGBPix(aData)^[0];
  4105. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  4106. PRGBPix(aData)^[2] := Temp;
  4107. if aHasAlpha then
  4108. Inc(aData, 4)
  4109. else
  4110. Inc(aData, 3);
  4111. dec(aWidth);
  4112. end;
  4113. end;
  4114. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4115. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4116. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4117. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  4118. begin
  4119. result := TFormatDescriptor.Get(Format);
  4120. end;
  4121. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4122. function TglBitmap.GetWidth: Integer;
  4123. begin
  4124. if (ffX in fDimension.Fields) then
  4125. result := fDimension.X
  4126. else
  4127. result := -1;
  4128. end;
  4129. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4130. function TglBitmap.GetHeight: Integer;
  4131. begin
  4132. if (ffY in fDimension.Fields) then
  4133. result := fDimension.Y
  4134. else
  4135. result := -1;
  4136. end;
  4137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4138. function TglBitmap.GetFileWidth: Integer;
  4139. begin
  4140. result := Max(1, Width);
  4141. end;
  4142. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4143. function TglBitmap.GetFileHeight: Integer;
  4144. begin
  4145. result := Max(1, Height);
  4146. end;
  4147. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4148. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  4149. begin
  4150. if fCustomData = aValue then
  4151. exit;
  4152. fCustomData := aValue;
  4153. end;
  4154. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4155. procedure TglBitmap.SetCustomName(const aValue: String);
  4156. begin
  4157. if fCustomName = aValue then
  4158. exit;
  4159. fCustomName := aValue;
  4160. end;
  4161. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4162. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  4163. begin
  4164. if fCustomNameW = aValue then
  4165. exit;
  4166. fCustomNameW := aValue;
  4167. end;
  4168. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4169. procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
  4170. begin
  4171. if fFreeDataOnDestroy = aValue then
  4172. exit;
  4173. fFreeDataOnDestroy := aValue;
  4174. end;
  4175. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4176. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  4177. begin
  4178. if fDeleteTextureOnFree = aValue then
  4179. exit;
  4180. fDeleteTextureOnFree := aValue;
  4181. end;
  4182. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4183. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  4184. begin
  4185. if fFormat = aValue then
  4186. exit;
  4187. if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
  4188. raise EglBitmapUnsupportedFormat.Create(Format);
  4189. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  4190. end;
  4191. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4192. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  4193. begin
  4194. if fFreeDataAfterGenTexture = aValue then
  4195. exit;
  4196. fFreeDataAfterGenTexture := aValue;
  4197. end;
  4198. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4199. procedure TglBitmap.SetID(const aValue: Cardinal);
  4200. begin
  4201. if fID = aValue then
  4202. exit;
  4203. fID := aValue;
  4204. end;
  4205. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4206. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  4207. begin
  4208. if fMipMap = aValue then
  4209. exit;
  4210. fMipMap := aValue;
  4211. end;
  4212. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4213. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  4214. begin
  4215. if fTarget = aValue then
  4216. exit;
  4217. fTarget := aValue;
  4218. end;
  4219. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4220. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  4221. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  4222. var
  4223. MaxAnisotropic: Integer;
  4224. {$IFEND}
  4225. begin
  4226. fAnisotropic := aValue;
  4227. if (ID > 0) then begin
  4228. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  4229. if GL_EXT_texture_filter_anisotropic then begin
  4230. if fAnisotropic > 0 then begin
  4231. Bind(false);
  4232. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  4233. if aValue > MaxAnisotropic then
  4234. fAnisotropic := MaxAnisotropic;
  4235. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  4236. end;
  4237. end else begin
  4238. fAnisotropic := 0;
  4239. end;
  4240. {$ELSE}
  4241. fAnisotropic := 0;
  4242. {$IFEND}
  4243. end;
  4244. end;
  4245. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4246. procedure TglBitmap.CreateID;
  4247. begin
  4248. if (ID <> 0) then
  4249. glDeleteTextures(1, @fID);
  4250. glGenTextures(1, @fID);
  4251. Bind(false);
  4252. end;
  4253. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4254. procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  4255. begin
  4256. // Set Up Parameters
  4257. SetWrap(fWrapS, fWrapT, fWrapR);
  4258. SetFilter(fFilterMin, fFilterMag);
  4259. SetAnisotropic(fAnisotropic);
  4260. {$IFNDEF OPENGL_ES}
  4261. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  4262. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4263. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  4264. {$ENDIF}
  4265. {$IFNDEF OPENGL_ES}
  4266. // Mip Maps Generation Mode
  4267. aBuildWithGlu := false;
  4268. if (MipMap = mmMipmap) then begin
  4269. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  4270. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  4271. else
  4272. aBuildWithGlu := true;
  4273. end else if (MipMap = mmMipmapGlu) then
  4274. aBuildWithGlu := true;
  4275. {$ELSE}
  4276. if (MipMap = mmMipmap) then
  4277. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
  4278. {$ENDIF}
  4279. end;
  4280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4281. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  4282. const aWidth: Integer; const aHeight: Integer);
  4283. var
  4284. s: Single;
  4285. begin
  4286. if (Data <> aData) then begin
  4287. if (Assigned(Data)) then
  4288. FreeMem(Data);
  4289. fData := aData;
  4290. end;
  4291. if not Assigned(fData) then begin
  4292. fPixelSize := 0;
  4293. fRowSize := 0;
  4294. end else begin
  4295. FillChar(fDimension, SizeOf(fDimension), 0);
  4296. if aWidth <> -1 then begin
  4297. fDimension.Fields := fDimension.Fields + [ffX];
  4298. fDimension.X := aWidth;
  4299. end;
  4300. if aHeight <> -1 then begin
  4301. fDimension.Fields := fDimension.Fields + [ffY];
  4302. fDimension.Y := aHeight;
  4303. end;
  4304. s := TFormatDescriptor.Get(aFormat).BytesPerPixel;
  4305. fFormat := aFormat;
  4306. fPixelSize := Ceil(s);
  4307. fRowSize := Ceil(s * aWidth);
  4308. end;
  4309. end;
  4310. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4311. function TglBitmap.FlipHorz: Boolean;
  4312. begin
  4313. result := false;
  4314. end;
  4315. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4316. function TglBitmap.FlipVert: Boolean;
  4317. begin
  4318. result := false;
  4319. end;
  4320. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4321. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4322. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4323. procedure TglBitmap.AfterConstruction;
  4324. begin
  4325. inherited AfterConstruction;
  4326. fID := 0;
  4327. fTarget := 0;
  4328. {$IFNDEF OPENGL_ES}
  4329. fIsResident := false;
  4330. {$ENDIF}
  4331. fMipMap := glBitmapDefaultMipmap;
  4332. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  4333. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  4334. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  4335. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  4336. {$IFNDEF OPENGL_ES}
  4337. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  4338. {$ENDIF}
  4339. end;
  4340. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4341. procedure TglBitmap.BeforeDestruction;
  4342. var
  4343. NewData: PByte;
  4344. begin
  4345. if fFreeDataOnDestroy then begin
  4346. NewData := nil;
  4347. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  4348. end;
  4349. if (fID > 0) and fDeleteTextureOnFree then
  4350. glDeleteTextures(1, @fID);
  4351. inherited BeforeDestruction;
  4352. end;
  4353. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4354. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  4355. var
  4356. TempPos: Integer;
  4357. begin
  4358. if not Assigned(aResType) then begin
  4359. TempPos := Pos('.', aResource);
  4360. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  4361. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  4362. end;
  4363. end;
  4364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4365. procedure TglBitmap.LoadFromFile(const aFilename: String);
  4366. var
  4367. fs: TFileStream;
  4368. begin
  4369. if not FileExists(aFilename) then
  4370. raise EglBitmap.Create('file does not exist: ' + aFilename);
  4371. fFilename := aFilename;
  4372. fs := TFileStream.Create(fFilename, fmOpenRead);
  4373. try
  4374. fs.Position := 0;
  4375. LoadFromStream(fs);
  4376. finally
  4377. fs.Free;
  4378. end;
  4379. end;
  4380. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4381. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  4382. begin
  4383. {$IFDEF GLB_SUPPORT_PNG_READ}
  4384. if not LoadPNG(aStream) then
  4385. {$ENDIF}
  4386. {$IFDEF GLB_SUPPORT_JPEG_READ}
  4387. if not LoadJPEG(aStream) then
  4388. {$ENDIF}
  4389. if not LoadDDS(aStream) then
  4390. if not LoadTGA(aStream) then
  4391. if not LoadBMP(aStream) then
  4392. if not LoadRAW(aStream) then
  4393. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  4394. end;
  4395. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4396. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  4397. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  4398. var
  4399. tmpData: PByte;
  4400. size: Integer;
  4401. begin
  4402. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4403. GetMem(tmpData, size);
  4404. try
  4405. FillChar(tmpData^, size, #$FF);
  4406. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4407. except
  4408. if Assigned(tmpData) then
  4409. FreeMem(tmpData);
  4410. raise;
  4411. end;
  4412. AddFunc(Self, aFunc, false, aFormat, aArgs);
  4413. end;
  4414. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4415. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  4416. var
  4417. rs: TResourceStream;
  4418. begin
  4419. PrepareResType(aResource, aResType);
  4420. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4421. try
  4422. LoadFromStream(rs);
  4423. finally
  4424. rs.Free;
  4425. end;
  4426. end;
  4427. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4428. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4429. var
  4430. rs: TResourceStream;
  4431. begin
  4432. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4433. try
  4434. LoadFromStream(rs);
  4435. finally
  4436. rs.Free;
  4437. end;
  4438. end;
  4439. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4440. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  4441. var
  4442. fs: TFileStream;
  4443. begin
  4444. fs := TFileStream.Create(aFileName, fmCreate);
  4445. try
  4446. fs.Position := 0;
  4447. SaveToStream(fs, aFileType);
  4448. finally
  4449. fs.Free;
  4450. end;
  4451. end;
  4452. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4453. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  4454. begin
  4455. case aFileType of
  4456. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4457. ftPNG: SavePNG(aStream);
  4458. {$ENDIF}
  4459. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  4460. ftJPEG: SaveJPEG(aStream);
  4461. {$ENDIF}
  4462. ftDDS: SaveDDS(aStream);
  4463. ftTGA: SaveTGA(aStream);
  4464. ftBMP: SaveBMP(aStream);
  4465. ftRAW: SaveRAW(aStream);
  4466. end;
  4467. end;
  4468. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4469. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  4470. begin
  4471. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  4472. end;
  4473. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4474. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  4475. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  4476. var
  4477. DestData, TmpData, SourceData: pByte;
  4478. TempHeight, TempWidth: Integer;
  4479. SourceFD, DestFD: TFormatDescriptor;
  4480. SourceMD, DestMD: Pointer;
  4481. FuncRec: TglBitmapFunctionRec;
  4482. begin
  4483. Assert(Assigned(Data));
  4484. Assert(Assigned(aSource));
  4485. Assert(Assigned(aSource.Data));
  4486. result := false;
  4487. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  4488. SourceFD := TFormatDescriptor.Get(aSource.Format);
  4489. DestFD := TFormatDescriptor.Get(aFormat);
  4490. if (SourceFD.IsCompressed) then
  4491. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  4492. if (DestFD.IsCompressed) then
  4493. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  4494. // inkompatible Formats so CreateTemp
  4495. if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
  4496. aCreateTemp := true;
  4497. // Values
  4498. TempHeight := Max(1, aSource.Height);
  4499. TempWidth := Max(1, aSource.Width);
  4500. FuncRec.Sender := Self;
  4501. FuncRec.Args := aArgs;
  4502. TmpData := nil;
  4503. if aCreateTemp then begin
  4504. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  4505. DestData := TmpData;
  4506. end else
  4507. DestData := Data;
  4508. try
  4509. SourceFD.PreparePixel(FuncRec.Source);
  4510. DestFD.PreparePixel (FuncRec.Dest);
  4511. SourceMD := SourceFD.CreateMappingData;
  4512. DestMD := DestFD.CreateMappingData;
  4513. FuncRec.Size := aSource.Dimension;
  4514. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4515. try
  4516. SourceData := aSource.Data;
  4517. FuncRec.Position.Y := 0;
  4518. while FuncRec.Position.Y < TempHeight do begin
  4519. FuncRec.Position.X := 0;
  4520. while FuncRec.Position.X < TempWidth do begin
  4521. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4522. aFunc(FuncRec);
  4523. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  4524. inc(FuncRec.Position.X);
  4525. end;
  4526. inc(FuncRec.Position.Y);
  4527. end;
  4528. // Updating Image or InternalFormat
  4529. if aCreateTemp then
  4530. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  4531. else if (aFormat <> fFormat) then
  4532. Format := aFormat;
  4533. result := true;
  4534. finally
  4535. SourceFD.FreeMappingData(SourceMD);
  4536. DestFD.FreeMappingData(DestMD);
  4537. end;
  4538. except
  4539. if aCreateTemp and Assigned(TmpData) then
  4540. FreeMem(TmpData);
  4541. raise;
  4542. end;
  4543. end;
  4544. end;
  4545. {$IFDEF GLB_SDL}
  4546. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4547. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  4548. var
  4549. Row, RowSize: Integer;
  4550. SourceData, TmpData: PByte;
  4551. TempDepth: Integer;
  4552. FormatDesc: TFormatDescriptor;
  4553. function GetRowPointer(Row: Integer): pByte;
  4554. begin
  4555. result := aSurface.pixels;
  4556. Inc(result, Row * RowSize);
  4557. end;
  4558. begin
  4559. result := false;
  4560. FormatDesc := TFormatDescriptor.Get(Format);
  4561. if FormatDesc.IsCompressed then
  4562. raise EglBitmapUnsupportedFormat.Create(Format);
  4563. if Assigned(Data) then begin
  4564. case Trunc(FormatDesc.PixelSize) of
  4565. 1: TempDepth := 8;
  4566. 2: TempDepth := 16;
  4567. 3: TempDepth := 24;
  4568. 4: TempDepth := 32;
  4569. else
  4570. raise EglBitmapUnsupportedFormat.Create(Format);
  4571. end;
  4572. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4573. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4574. SourceData := Data;
  4575. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4576. for Row := 0 to FileHeight-1 do begin
  4577. TmpData := GetRowPointer(Row);
  4578. if Assigned(TmpData) then begin
  4579. Move(SourceData^, TmpData^, RowSize);
  4580. inc(SourceData, RowSize);
  4581. end;
  4582. end;
  4583. result := true;
  4584. end;
  4585. end;
  4586. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4587. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4588. var
  4589. pSource, pData, pTempData: PByte;
  4590. Row, RowSize, TempWidth, TempHeight: Integer;
  4591. IntFormat: TglBitmapFormat;
  4592. fd: TFormatDescriptor;
  4593. Mask: TglBitmapMask;
  4594. function GetRowPointer(Row: Integer): pByte;
  4595. begin
  4596. result := aSurface^.pixels;
  4597. Inc(result, Row * RowSize);
  4598. end;
  4599. begin
  4600. result := false;
  4601. if (Assigned(aSurface)) then begin
  4602. with aSurface^.format^ do begin
  4603. Mask.r := RMask;
  4604. Mask.g := GMask;
  4605. Mask.b := BMask;
  4606. Mask.a := AMask;
  4607. IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
  4608. if (IntFormat = tfEmpty) then
  4609. raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
  4610. end;
  4611. fd := TFormatDescriptor.Get(IntFormat);
  4612. TempWidth := aSurface^.w;
  4613. TempHeight := aSurface^.h;
  4614. RowSize := fd.GetSize(TempWidth, 1);
  4615. GetMem(pData, TempHeight * RowSize);
  4616. try
  4617. pTempData := pData;
  4618. for Row := 0 to TempHeight -1 do begin
  4619. pSource := GetRowPointer(Row);
  4620. if (Assigned(pSource)) then begin
  4621. Move(pSource^, pTempData^, RowSize);
  4622. Inc(pTempData, RowSize);
  4623. end;
  4624. end;
  4625. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4626. result := true;
  4627. except
  4628. if Assigned(pData) then
  4629. FreeMem(pData);
  4630. raise;
  4631. end;
  4632. end;
  4633. end;
  4634. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4635. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4636. var
  4637. Row, Col, AlphaInterleave: Integer;
  4638. pSource, pDest: PByte;
  4639. function GetRowPointer(Row: Integer): pByte;
  4640. begin
  4641. result := aSurface.pixels;
  4642. Inc(result, Row * Width);
  4643. end;
  4644. begin
  4645. result := false;
  4646. if Assigned(Data) then begin
  4647. if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
  4648. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4649. AlphaInterleave := 0;
  4650. case Format of
  4651. tfLuminance8Alpha8ub2:
  4652. AlphaInterleave := 1;
  4653. tfBGRA8ub4, tfRGBA8ub4:
  4654. AlphaInterleave := 3;
  4655. end;
  4656. pSource := Data;
  4657. for Row := 0 to Height -1 do begin
  4658. pDest := GetRowPointer(Row);
  4659. if Assigned(pDest) then begin
  4660. for Col := 0 to Width -1 do begin
  4661. Inc(pSource, AlphaInterleave);
  4662. pDest^ := pSource^;
  4663. Inc(pDest);
  4664. Inc(pSource);
  4665. end;
  4666. end;
  4667. end;
  4668. result := true;
  4669. end;
  4670. end;
  4671. end;
  4672. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4673. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4674. var
  4675. bmp: TglBitmap2D;
  4676. begin
  4677. bmp := TglBitmap2D.Create;
  4678. try
  4679. bmp.AssignFromSurface(aSurface);
  4680. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4681. finally
  4682. bmp.Free;
  4683. end;
  4684. end;
  4685. {$ENDIF}
  4686. {$IFDEF GLB_DELPHI}
  4687. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4688. function CreateGrayPalette: HPALETTE;
  4689. var
  4690. Idx: Integer;
  4691. Pal: PLogPalette;
  4692. begin
  4693. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4694. Pal.palVersion := $300;
  4695. Pal.palNumEntries := 256;
  4696. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4697. Pal.palPalEntry[Idx].peRed := Idx;
  4698. Pal.palPalEntry[Idx].peGreen := Idx;
  4699. Pal.palPalEntry[Idx].peBlue := Idx;
  4700. Pal.palPalEntry[Idx].peFlags := 0;
  4701. end;
  4702. Result := CreatePalette(Pal^);
  4703. FreeMem(Pal);
  4704. end;
  4705. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4706. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4707. var
  4708. Row: Integer;
  4709. pSource, pData: PByte;
  4710. begin
  4711. result := false;
  4712. if Assigned(Data) then begin
  4713. if Assigned(aBitmap) then begin
  4714. aBitmap.Width := Width;
  4715. aBitmap.Height := Height;
  4716. case Format of
  4717. tfAlpha8ub1, tfLuminance8ub1: begin
  4718. aBitmap.PixelFormat := pf8bit;
  4719. aBitmap.Palette := CreateGrayPalette;
  4720. end;
  4721. tfRGB5A1us1:
  4722. aBitmap.PixelFormat := pf15bit;
  4723. tfR5G6B5us1:
  4724. aBitmap.PixelFormat := pf16bit;
  4725. tfRGB8ub3, tfBGR8ub3:
  4726. aBitmap.PixelFormat := pf24bit;
  4727. tfRGBA8ub4, tfBGRA8ub4:
  4728. aBitmap.PixelFormat := pf32bit;
  4729. else
  4730. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4731. end;
  4732. pSource := Data;
  4733. for Row := 0 to FileHeight -1 do begin
  4734. pData := aBitmap.Scanline[Row];
  4735. Move(pSource^, pData^, fRowSize);
  4736. Inc(pSource, fRowSize);
  4737. if (Format in [tfRGB8ub3, tfRGBA8ub4]) then // swap RGB(A) to BGR(A)
  4738. SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
  4739. end;
  4740. result := true;
  4741. end;
  4742. end;
  4743. end;
  4744. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4745. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4746. var
  4747. pSource, pData, pTempData: PByte;
  4748. Row, RowSize, TempWidth, TempHeight: Integer;
  4749. IntFormat: TglBitmapFormat;
  4750. begin
  4751. result := false;
  4752. if (Assigned(aBitmap)) then begin
  4753. case aBitmap.PixelFormat of
  4754. pf8bit:
  4755. IntFormat := tfLuminance8ub1;
  4756. pf15bit:
  4757. IntFormat := tfRGB5A1us1;
  4758. pf16bit:
  4759. IntFormat := tfR5G6B5us1;
  4760. pf24bit:
  4761. IntFormat := tfBGR8ub3;
  4762. pf32bit:
  4763. IntFormat := tfBGRA8ub4;
  4764. else
  4765. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4766. end;
  4767. TempWidth := aBitmap.Width;
  4768. TempHeight := aBitmap.Height;
  4769. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4770. GetMem(pData, TempHeight * RowSize);
  4771. try
  4772. pTempData := pData;
  4773. for Row := 0 to TempHeight -1 do begin
  4774. pSource := aBitmap.Scanline[Row];
  4775. if (Assigned(pSource)) then begin
  4776. Move(pSource^, pTempData^, RowSize);
  4777. Inc(pTempData, RowSize);
  4778. end;
  4779. end;
  4780. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4781. result := true;
  4782. except
  4783. if Assigned(pData) then
  4784. FreeMem(pData);
  4785. raise;
  4786. end;
  4787. end;
  4788. end;
  4789. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4790. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4791. var
  4792. Row, Col, AlphaInterleave: Integer;
  4793. pSource, pDest: PByte;
  4794. begin
  4795. result := false;
  4796. if Assigned(Data) then begin
  4797. if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
  4798. if Assigned(aBitmap) then begin
  4799. aBitmap.PixelFormat := pf8bit;
  4800. aBitmap.Palette := CreateGrayPalette;
  4801. aBitmap.Width := Width;
  4802. aBitmap.Height := Height;
  4803. case Format of
  4804. tfLuminance8Alpha8ub2:
  4805. AlphaInterleave := 1;
  4806. tfRGBA8ub4, tfBGRA8ub4:
  4807. AlphaInterleave := 3;
  4808. else
  4809. AlphaInterleave := 0;
  4810. end;
  4811. // Copy Data
  4812. pSource := Data;
  4813. for Row := 0 to Height -1 do begin
  4814. pDest := aBitmap.Scanline[Row];
  4815. if Assigned(pDest) then begin
  4816. for Col := 0 to Width -1 do begin
  4817. Inc(pSource, AlphaInterleave);
  4818. pDest^ := pSource^;
  4819. Inc(pDest);
  4820. Inc(pSource);
  4821. end;
  4822. end;
  4823. end;
  4824. result := true;
  4825. end;
  4826. end;
  4827. end;
  4828. end;
  4829. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4830. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4831. var
  4832. tex: TglBitmap2D;
  4833. begin
  4834. tex := TglBitmap2D.Create;
  4835. try
  4836. tex.AssignFromBitmap(ABitmap);
  4837. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4838. finally
  4839. tex.Free;
  4840. end;
  4841. end;
  4842. {$ENDIF}
  4843. {$IFDEF GLB_LAZARUS}
  4844. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4845. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4846. var
  4847. rid: TRawImageDescription;
  4848. FormatDesc: TFormatDescriptor;
  4849. begin
  4850. if not Assigned(Data) then
  4851. raise EglBitmap.Create('no pixel data assigned. load data before save');
  4852. result := false;
  4853. if not Assigned(aImage) or (Format = tfEmpty) then
  4854. exit;
  4855. FormatDesc := TFormatDescriptor.Get(Format);
  4856. if FormatDesc.IsCompressed then
  4857. exit;
  4858. FillChar(rid{%H-}, SizeOf(rid), 0);
  4859. if FormatDesc.IsGrayscale then
  4860. rid.Format := ricfGray
  4861. else
  4862. rid.Format := ricfRGBA;
  4863. rid.Width := Width;
  4864. rid.Height := Height;
  4865. rid.Depth := FormatDesc.BitsPerPixel;
  4866. rid.BitOrder := riboBitsInOrder;
  4867. rid.ByteOrder := riboLSBFirst;
  4868. rid.LineOrder := riloTopToBottom;
  4869. rid.LineEnd := rileTight;
  4870. rid.BitsPerPixel := FormatDesc.BitsPerPixel;
  4871. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4872. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4873. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4874. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4875. rid.RedShift := FormatDesc.Shift.r;
  4876. rid.GreenShift := FormatDesc.Shift.g;
  4877. rid.BlueShift := FormatDesc.Shift.b;
  4878. rid.AlphaShift := FormatDesc.Shift.a;
  4879. rid.MaskBitsPerPixel := 0;
  4880. rid.PaletteColorCount := 0;
  4881. aImage.DataDescription := rid;
  4882. aImage.CreateData;
  4883. if not Assigned(aImage.PixelData) then
  4884. raise EglBitmap.Create('error while creating LazIntfImage');
  4885. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4886. result := true;
  4887. end;
  4888. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4889. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4890. var
  4891. f: TglBitmapFormat;
  4892. FormatDesc: TFormatDescriptor;
  4893. ImageData: PByte;
  4894. ImageSize: Integer;
  4895. CanCopy: Boolean;
  4896. Mask: TglBitmapRec4ul;
  4897. procedure CopyConvert;
  4898. var
  4899. bfFormat: TbmpBitfieldFormat;
  4900. pSourceLine, pDestLine: PByte;
  4901. pSourceMD, pDestMD: Pointer;
  4902. Shift, Prec: TglBitmapRec4ub;
  4903. x, y: Integer;
  4904. pixel: TglBitmapPixelData;
  4905. begin
  4906. bfFormat := TbmpBitfieldFormat.Create;
  4907. with aImage.DataDescription do begin
  4908. Prec.r := RedPrec;
  4909. Prec.g := GreenPrec;
  4910. Prec.b := BluePrec;
  4911. Prec.a := AlphaPrec;
  4912. Shift.r := RedShift;
  4913. Shift.g := GreenShift;
  4914. Shift.b := BlueShift;
  4915. Shift.a := AlphaShift;
  4916. bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
  4917. end;
  4918. pSourceMD := bfFormat.CreateMappingData;
  4919. pDestMD := FormatDesc.CreateMappingData;
  4920. try
  4921. for y := 0 to aImage.Height-1 do begin
  4922. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  4923. pDestLine := ImageData + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
  4924. for x := 0 to aImage.Width-1 do begin
  4925. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  4926. FormatDesc.Map(pixel, pDestLine, pDestMD);
  4927. end;
  4928. end;
  4929. finally
  4930. FormatDesc.FreeMappingData(pDestMD);
  4931. bfFormat.FreeMappingData(pSourceMD);
  4932. bfFormat.Free;
  4933. end;
  4934. end;
  4935. begin
  4936. result := false;
  4937. if not Assigned(aImage) then
  4938. exit;
  4939. with aImage.DataDescription do begin
  4940. Mask.r := (QWord(1 shl RedPrec )-1) shl RedShift;
  4941. Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
  4942. Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
  4943. Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
  4944. end;
  4945. FormatDesc := TFormatDescriptor.GetFromMask(Mask);
  4946. f := FormatDesc.Format;
  4947. if (f = tfEmpty) then
  4948. exit;
  4949. CanCopy :=
  4950. (FormatDesc.BitsPerPixel = aImage.DataDescription.Depth) and
  4951. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  4952. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4953. ImageData := GetMem(ImageSize);
  4954. try
  4955. if CanCopy then
  4956. Move(aImage.PixelData^, ImageData^, ImageSize)
  4957. else
  4958. CopyConvert;
  4959. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4960. except
  4961. if Assigned(ImageData) then
  4962. FreeMem(ImageData);
  4963. raise;
  4964. end;
  4965. result := true;
  4966. end;
  4967. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4968. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4969. var
  4970. rid: TRawImageDescription;
  4971. FormatDesc: TFormatDescriptor;
  4972. Pixel: TglBitmapPixelData;
  4973. x, y: Integer;
  4974. srcMD: Pointer;
  4975. src, dst: PByte;
  4976. begin
  4977. result := false;
  4978. if not Assigned(aImage) or (Format = tfEmpty) then
  4979. exit;
  4980. FormatDesc := TFormatDescriptor.Get(Format);
  4981. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4982. exit;
  4983. FillChar(rid{%H-}, SizeOf(rid), 0);
  4984. rid.Format := ricfGray;
  4985. rid.Width := Width;
  4986. rid.Height := Height;
  4987. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4988. rid.BitOrder := riboBitsInOrder;
  4989. rid.ByteOrder := riboLSBFirst;
  4990. rid.LineOrder := riloTopToBottom;
  4991. rid.LineEnd := rileTight;
  4992. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4993. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4994. rid.GreenPrec := 0;
  4995. rid.BluePrec := 0;
  4996. rid.AlphaPrec := 0;
  4997. rid.RedShift := 0;
  4998. rid.GreenShift := 0;
  4999. rid.BlueShift := 0;
  5000. rid.AlphaShift := 0;
  5001. rid.MaskBitsPerPixel := 0;
  5002. rid.PaletteColorCount := 0;
  5003. aImage.DataDescription := rid;
  5004. aImage.CreateData;
  5005. srcMD := FormatDesc.CreateMappingData;
  5006. try
  5007. FormatDesc.PreparePixel(Pixel);
  5008. src := Data;
  5009. dst := aImage.PixelData;
  5010. for y := 0 to Height-1 do
  5011. for x := 0 to Width-1 do begin
  5012. FormatDesc.Unmap(src, Pixel, srcMD);
  5013. case rid.BitsPerPixel of
  5014. 8: begin
  5015. dst^ := Pixel.Data.a;
  5016. inc(dst);
  5017. end;
  5018. 16: begin
  5019. PWord(dst)^ := Pixel.Data.a;
  5020. inc(dst, 2);
  5021. end;
  5022. 24: begin
  5023. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  5024. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  5025. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  5026. inc(dst, 3);
  5027. end;
  5028. 32: begin
  5029. PCardinal(dst)^ := Pixel.Data.a;
  5030. inc(dst, 4);
  5031. end;
  5032. else
  5033. raise EglBitmapUnsupportedFormat.Create(Format);
  5034. end;
  5035. end;
  5036. finally
  5037. FormatDesc.FreeMappingData(srcMD);
  5038. end;
  5039. result := true;
  5040. end;
  5041. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5042. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5043. var
  5044. tex: TglBitmap2D;
  5045. begin
  5046. tex := TglBitmap2D.Create;
  5047. try
  5048. tex.AssignFromLazIntfImage(aImage);
  5049. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  5050. finally
  5051. tex.Free;
  5052. end;
  5053. end;
  5054. {$ENDIF}
  5055. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5056. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  5057. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5058. var
  5059. rs: TResourceStream;
  5060. begin
  5061. PrepareResType(aResource, aResType);
  5062. rs := TResourceStream.Create(aInstance, aResource, aResType);
  5063. try
  5064. result := AddAlphaFromStream(rs, aFunc, aArgs);
  5065. finally
  5066. rs.Free;
  5067. end;
  5068. end;
  5069. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5070. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  5071. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5072. var
  5073. rs: TResourceStream;
  5074. begin
  5075. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  5076. try
  5077. result := AddAlphaFromStream(rs, aFunc, aArgs);
  5078. finally
  5079. rs.Free;
  5080. end;
  5081. end;
  5082. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5083. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5084. begin
  5085. if TFormatDescriptor.Get(Format).IsCompressed then
  5086. raise EglBitmapUnsupportedFormat.Create(Format);
  5087. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  5088. end;
  5089. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5090. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5091. var
  5092. FS: TFileStream;
  5093. begin
  5094. FS := TFileStream.Create(aFileName, fmOpenRead);
  5095. try
  5096. result := AddAlphaFromStream(FS, aFunc, aArgs);
  5097. finally
  5098. FS.Free;
  5099. end;
  5100. end;
  5101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5102. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5103. var
  5104. tex: TglBitmap2D;
  5105. begin
  5106. tex := TglBitmap2D.Create(aStream);
  5107. try
  5108. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  5109. finally
  5110. tex.Free;
  5111. end;
  5112. end;
  5113. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5114. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5115. var
  5116. DestData, DestData2, SourceData: pByte;
  5117. TempHeight, TempWidth: Integer;
  5118. SourceFD, DestFD: TFormatDescriptor;
  5119. SourceMD, DestMD, DestMD2: Pointer;
  5120. FuncRec: TglBitmapFunctionRec;
  5121. begin
  5122. result := false;
  5123. Assert(Assigned(Data));
  5124. Assert(Assigned(aBitmap));
  5125. Assert(Assigned(aBitmap.Data));
  5126. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  5127. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  5128. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  5129. DestFD := TFormatDescriptor.Get(Format);
  5130. if not Assigned(aFunc) then begin
  5131. aFunc := glBitmapAlphaFunc;
  5132. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  5133. end else
  5134. FuncRec.Args := aArgs;
  5135. // Values
  5136. TempHeight := aBitmap.FileHeight;
  5137. TempWidth := aBitmap.FileWidth;
  5138. FuncRec.Sender := Self;
  5139. FuncRec.Size := Dimension;
  5140. FuncRec.Position.Fields := FuncRec.Size.Fields;
  5141. DestData := Data;
  5142. DestData2 := Data;
  5143. SourceData := aBitmap.Data;
  5144. // Mapping
  5145. SourceFD.PreparePixel(FuncRec.Source);
  5146. DestFD.PreparePixel (FuncRec.Dest);
  5147. SourceMD := SourceFD.CreateMappingData;
  5148. DestMD := DestFD.CreateMappingData;
  5149. DestMD2 := DestFD.CreateMappingData;
  5150. try
  5151. FuncRec.Position.Y := 0;
  5152. while FuncRec.Position.Y < TempHeight do begin
  5153. FuncRec.Position.X := 0;
  5154. while FuncRec.Position.X < TempWidth do begin
  5155. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  5156. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  5157. aFunc(FuncRec);
  5158. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  5159. inc(FuncRec.Position.X);
  5160. end;
  5161. inc(FuncRec.Position.Y);
  5162. end;
  5163. finally
  5164. SourceFD.FreeMappingData(SourceMD);
  5165. DestFD.FreeMappingData(DestMD);
  5166. DestFD.FreeMappingData(DestMD2);
  5167. end;
  5168. end;
  5169. end;
  5170. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5171. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  5172. begin
  5173. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  5174. end;
  5175. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5176. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  5177. var
  5178. PixelData: TglBitmapPixelData;
  5179. begin
  5180. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5181. result := AddAlphaFromColorKeyFloat(
  5182. aRed / PixelData.Range.r,
  5183. aGreen / PixelData.Range.g,
  5184. aBlue / PixelData.Range.b,
  5185. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  5186. end;
  5187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5188. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  5189. var
  5190. values: array[0..2] of Single;
  5191. tmp: Cardinal;
  5192. i: Integer;
  5193. PixelData: TglBitmapPixelData;
  5194. begin
  5195. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5196. with PixelData do begin
  5197. values[0] := aRed;
  5198. values[1] := aGreen;
  5199. values[2] := aBlue;
  5200. for i := 0 to 2 do begin
  5201. tmp := Trunc(Range.arr[i] * aDeviation);
  5202. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  5203. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  5204. end;
  5205. Data.a := 0;
  5206. Range.a := 0;
  5207. end;
  5208. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  5209. end;
  5210. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5211. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  5212. begin
  5213. result := AddAlphaFromValueFloat(aAlpha / $FF);
  5214. end;
  5215. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5216. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  5217. var
  5218. PixelData: TglBitmapPixelData;
  5219. begin
  5220. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5221. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  5222. end;
  5223. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5224. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  5225. var
  5226. PixelData: TglBitmapPixelData;
  5227. begin
  5228. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5229. with PixelData do
  5230. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  5231. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  5232. end;
  5233. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5234. function TglBitmap.RemoveAlpha: Boolean;
  5235. var
  5236. FormatDesc: TFormatDescriptor;
  5237. begin
  5238. result := false;
  5239. FormatDesc := TFormatDescriptor.Get(Format);
  5240. if Assigned(Data) then begin
  5241. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  5242. raise EglBitmapUnsupportedFormat.Create(Format);
  5243. result := ConvertTo(FormatDesc.WithoutAlpha);
  5244. end;
  5245. end;
  5246. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5247. function TglBitmap.Clone: TglBitmap;
  5248. var
  5249. Temp: TglBitmap;
  5250. TempPtr: PByte;
  5251. Size: Integer;
  5252. begin
  5253. result := nil;
  5254. Temp := (ClassType.Create as TglBitmap);
  5255. try
  5256. // copy texture data if assigned
  5257. if Assigned(Data) then begin
  5258. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  5259. GetMem(TempPtr, Size);
  5260. try
  5261. Move(Data^, TempPtr^, Size);
  5262. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  5263. except
  5264. if Assigned(TempPtr) then
  5265. FreeMem(TempPtr);
  5266. raise;
  5267. end;
  5268. end else begin
  5269. TempPtr := nil;
  5270. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  5271. end;
  5272. // copy properties
  5273. Temp.fID := ID;
  5274. Temp.fTarget := Target;
  5275. Temp.fFormat := Format;
  5276. Temp.fMipMap := MipMap;
  5277. Temp.fAnisotropic := Anisotropic;
  5278. Temp.fBorderColor := fBorderColor;
  5279. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  5280. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  5281. Temp.fFilterMin := fFilterMin;
  5282. Temp.fFilterMag := fFilterMag;
  5283. Temp.fWrapS := fWrapS;
  5284. Temp.fWrapT := fWrapT;
  5285. Temp.fWrapR := fWrapR;
  5286. Temp.fFilename := fFilename;
  5287. Temp.fCustomName := fCustomName;
  5288. Temp.fCustomNameW := fCustomNameW;
  5289. Temp.fCustomData := fCustomData;
  5290. result := Temp;
  5291. except
  5292. FreeAndNil(Temp);
  5293. raise;
  5294. end;
  5295. end;
  5296. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5297. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  5298. var
  5299. SourceFD, DestFD: TFormatDescriptor;
  5300. SourcePD, DestPD: TglBitmapPixelData;
  5301. ShiftData: TShiftData;
  5302. function DataIsIdentical: Boolean;
  5303. begin
  5304. result := SourceFD.MaskMatch(DestFD.Mask);
  5305. end;
  5306. function CanCopyDirect: Boolean;
  5307. begin
  5308. result :=
  5309. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5310. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5311. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5312. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5313. end;
  5314. function CanShift: Boolean;
  5315. begin
  5316. result :=
  5317. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5318. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5319. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5320. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5321. end;
  5322. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  5323. begin
  5324. result := 0;
  5325. while (aSource > aDest) and (aSource > 0) do begin
  5326. inc(result);
  5327. aSource := aSource shr 1;
  5328. end;
  5329. end;
  5330. begin
  5331. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  5332. SourceFD := TFormatDescriptor.Get(Format);
  5333. DestFD := TFormatDescriptor.Get(aFormat);
  5334. if DataIsIdentical then begin
  5335. result := true;
  5336. Format := aFormat;
  5337. exit;
  5338. end;
  5339. SourceFD.PreparePixel(SourcePD);
  5340. DestFD.PreparePixel (DestPD);
  5341. if CanCopyDirect then
  5342. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  5343. else if CanShift then begin
  5344. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  5345. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  5346. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  5347. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  5348. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  5349. end else
  5350. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  5351. end else
  5352. result := true;
  5353. end;
  5354. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5355. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  5356. begin
  5357. if aUseRGB or aUseAlpha then
  5358. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  5359. ((Byte(aUseAlpha) and 1) shl 1) or
  5360. (Byte(aUseRGB) and 1) ));
  5361. end;
  5362. {$IFNDEF OPENGL_ES}
  5363. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5364. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  5365. begin
  5366. fBorderColor[0] := aRed;
  5367. fBorderColor[1] := aGreen;
  5368. fBorderColor[2] := aBlue;
  5369. fBorderColor[3] := aAlpha;
  5370. if (ID > 0) then begin
  5371. Bind(false);
  5372. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  5373. end;
  5374. end;
  5375. {$ENDIF}
  5376. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5377. procedure TglBitmap.FreeData;
  5378. var
  5379. TempPtr: PByte;
  5380. begin
  5381. TempPtr := nil;
  5382. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  5383. end;
  5384. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5385. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  5386. const aAlpha: Byte);
  5387. begin
  5388. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  5389. end;
  5390. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5391. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  5392. var
  5393. PixelData: TglBitmapPixelData;
  5394. begin
  5395. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5396. FillWithColorFloat(
  5397. aRed / PixelData.Range.r,
  5398. aGreen / PixelData.Range.g,
  5399. aBlue / PixelData.Range.b,
  5400. aAlpha / PixelData.Range.a);
  5401. end;
  5402. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5403. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  5404. var
  5405. PixelData: TglBitmapPixelData;
  5406. begin
  5407. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  5408. with PixelData do begin
  5409. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  5410. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  5411. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  5412. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  5413. end;
  5414. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  5415. end;
  5416. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5417. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  5418. begin
  5419. //check MIN filter
  5420. case aMin of
  5421. GL_NEAREST:
  5422. fFilterMin := GL_NEAREST;
  5423. GL_LINEAR:
  5424. fFilterMin := GL_LINEAR;
  5425. GL_NEAREST_MIPMAP_NEAREST:
  5426. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  5427. GL_LINEAR_MIPMAP_NEAREST:
  5428. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  5429. GL_NEAREST_MIPMAP_LINEAR:
  5430. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  5431. GL_LINEAR_MIPMAP_LINEAR:
  5432. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  5433. else
  5434. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  5435. end;
  5436. //check MAG filter
  5437. case aMag of
  5438. GL_NEAREST:
  5439. fFilterMag := GL_NEAREST;
  5440. GL_LINEAR:
  5441. fFilterMag := GL_LINEAR;
  5442. else
  5443. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  5444. end;
  5445. //apply filter
  5446. if (ID > 0) then begin
  5447. Bind(false);
  5448. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  5449. if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
  5450. case fFilterMin of
  5451. GL_NEAREST, GL_LINEAR:
  5452. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5453. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  5454. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  5455. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  5456. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  5457. end;
  5458. end else
  5459. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5460. end;
  5461. end;
  5462. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5463. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  5464. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  5465. begin
  5466. case aValue of
  5467. {$IFNDEF OPENGL_ES}
  5468. GL_CLAMP:
  5469. aTarget := GL_CLAMP;
  5470. {$ENDIF}
  5471. GL_REPEAT:
  5472. aTarget := GL_REPEAT;
  5473. GL_CLAMP_TO_EDGE: begin
  5474. {$IFNDEF OPENGL_ES}
  5475. if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
  5476. aTarget := GL_CLAMP
  5477. else
  5478. {$ENDIF}
  5479. aTarget := GL_CLAMP_TO_EDGE;
  5480. end;
  5481. {$IFNDEF OPENGL_ES}
  5482. GL_CLAMP_TO_BORDER: begin
  5483. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  5484. aTarget := GL_CLAMP_TO_BORDER
  5485. else
  5486. aTarget := GL_CLAMP;
  5487. end;
  5488. {$ENDIF}
  5489. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  5490. GL_MIRRORED_REPEAT: begin
  5491. {$IFNDEF OPENGL_ES}
  5492. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  5493. {$ELSE}
  5494. if GL_VERSION_2_0 then
  5495. {$ENDIF}
  5496. aTarget := GL_MIRRORED_REPEAT
  5497. else
  5498. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  5499. end;
  5500. {$IFEND}
  5501. else
  5502. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  5503. end;
  5504. end;
  5505. begin
  5506. CheckAndSetWrap(S, fWrapS);
  5507. CheckAndSetWrap(T, fWrapT);
  5508. CheckAndSetWrap(R, fWrapR);
  5509. if (ID > 0) then begin
  5510. Bind(false);
  5511. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  5512. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  5513. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  5514. {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
  5515. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  5516. {$IFEND}
  5517. end;
  5518. end;
  5519. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  5520. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5521. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  5522. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  5523. begin
  5524. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  5525. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  5526. fSwizzle[aIndex] := aValue
  5527. else
  5528. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  5529. end;
  5530. begin
  5531. {$IFNDEF OPENGL_ES}
  5532. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  5533. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  5534. {$ELSE}
  5535. if not GL_VERSION_3_0 then
  5536. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  5537. {$ENDIF}
  5538. CheckAndSetValue(r, 0);
  5539. CheckAndSetValue(g, 1);
  5540. CheckAndSetValue(b, 2);
  5541. CheckAndSetValue(a, 3);
  5542. if (ID > 0) then begin
  5543. Bind(false);
  5544. {$IFNDEF OPENGL_ES}
  5545. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  5546. {$ELSE}
  5547. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
  5548. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
  5549. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
  5550. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
  5551. {$ENDIF}
  5552. end;
  5553. end;
  5554. {$IFEND}
  5555. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5556. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  5557. begin
  5558. if aEnableTextureUnit then
  5559. glEnable(Target);
  5560. if (ID > 0) then
  5561. glBindTexture(Target, ID);
  5562. end;
  5563. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5564. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  5565. begin
  5566. if aDisableTextureUnit then
  5567. glDisable(Target);
  5568. glBindTexture(Target, 0);
  5569. end;
  5570. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5571. constructor TglBitmap.Create;
  5572. begin
  5573. if (ClassType = TglBitmap) then
  5574. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  5575. {$IFDEF GLB_NATIVE_OGL}
  5576. glbReadOpenGLExtensions;
  5577. {$ENDIF}
  5578. inherited Create;
  5579. fFormat := glBitmapGetDefaultFormat;
  5580. fFreeDataOnDestroy := true;
  5581. end;
  5582. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5583. constructor TglBitmap.Create(const aFileName: String);
  5584. begin
  5585. Create;
  5586. LoadFromFile(aFileName);
  5587. end;
  5588. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5589. constructor TglBitmap.Create(const aStream: TStream);
  5590. begin
  5591. Create;
  5592. LoadFromStream(aStream);
  5593. end;
  5594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5595. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
  5596. var
  5597. ImageSize: Integer;
  5598. begin
  5599. Create;
  5600. if not Assigned(aData) then begin
  5601. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5602. GetMem(aData, ImageSize);
  5603. try
  5604. FillChar(aData^, ImageSize, #$FF);
  5605. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5606. except
  5607. if Assigned(aData) then
  5608. FreeMem(aData);
  5609. raise;
  5610. end;
  5611. end else begin
  5612. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5613. fFreeDataOnDestroy := false;
  5614. end;
  5615. end;
  5616. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5617. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5618. begin
  5619. Create;
  5620. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  5621. end;
  5622. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5623. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  5624. begin
  5625. Create;
  5626. LoadFromResource(aInstance, aResource, aResType);
  5627. end;
  5628. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5629. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5630. begin
  5631. Create;
  5632. LoadFromResourceID(aInstance, aResourceID, aResType);
  5633. end;
  5634. {$IFDEF GLB_SUPPORT_PNG_READ}
  5635. {$IF DEFINED(GLB_LAZ_PNG)}
  5636. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5637. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5638. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5639. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5640. const
  5641. MAGIC_LEN = 8;
  5642. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  5643. var
  5644. reader: TLazReaderPNG;
  5645. intf: TLazIntfImage;
  5646. StreamPos: Int64;
  5647. magic: String[MAGIC_LEN];
  5648. begin
  5649. result := true;
  5650. StreamPos := aStream.Position;
  5651. SetLength(magic, MAGIC_LEN);
  5652. aStream.Read(magic[1], MAGIC_LEN);
  5653. aStream.Position := StreamPos;
  5654. if (magic <> PNG_MAGIC) then begin
  5655. result := false;
  5656. exit;
  5657. end;
  5658. intf := TLazIntfImage.Create(0, 0);
  5659. reader := TLazReaderPNG.Create;
  5660. try try
  5661. reader.UpdateDescription := true;
  5662. reader.ImageRead(aStream, intf);
  5663. AssignFromLazIntfImage(intf);
  5664. except
  5665. result := false;
  5666. aStream.Position := StreamPos;
  5667. exit;
  5668. end;
  5669. finally
  5670. reader.Free;
  5671. intf.Free;
  5672. end;
  5673. end;
  5674. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5675. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5676. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5677. var
  5678. Surface: PSDL_Surface;
  5679. RWops: PSDL_RWops;
  5680. begin
  5681. result := false;
  5682. RWops := glBitmapCreateRWops(aStream);
  5683. try
  5684. if IMG_isPNG(RWops) > 0 then begin
  5685. Surface := IMG_LoadPNG_RW(RWops);
  5686. try
  5687. AssignFromSurface(Surface);
  5688. result := true;
  5689. finally
  5690. SDL_FreeSurface(Surface);
  5691. end;
  5692. end;
  5693. finally
  5694. SDL_FreeRW(RWops);
  5695. end;
  5696. end;
  5697. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5698. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5699. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5700. begin
  5701. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5702. end;
  5703. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5704. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5705. var
  5706. StreamPos: Int64;
  5707. signature: array [0..7] of byte;
  5708. png: png_structp;
  5709. png_info: png_infop;
  5710. TempHeight, TempWidth: Integer;
  5711. Format: TglBitmapFormat;
  5712. png_data: pByte;
  5713. png_rows: array of pByte;
  5714. Row, LineSize: Integer;
  5715. begin
  5716. result := false;
  5717. if not init_libPNG then
  5718. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5719. try
  5720. // signature
  5721. StreamPos := aStream.Position;
  5722. aStream.Read(signature{%H-}, 8);
  5723. aStream.Position := StreamPos;
  5724. if png_check_sig(@signature, 8) <> 0 then begin
  5725. // png read struct
  5726. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5727. if png = nil then
  5728. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5729. // png info
  5730. png_info := png_create_info_struct(png);
  5731. if png_info = nil then begin
  5732. png_destroy_read_struct(@png, nil, nil);
  5733. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5734. end;
  5735. // set read callback
  5736. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5737. // read informations
  5738. png_read_info(png, png_info);
  5739. // size
  5740. TempHeight := png_get_image_height(png, png_info);
  5741. TempWidth := png_get_image_width(png, png_info);
  5742. // format
  5743. case png_get_color_type(png, png_info) of
  5744. PNG_COLOR_TYPE_GRAY:
  5745. Format := tfLuminance8ub1;
  5746. PNG_COLOR_TYPE_GRAY_ALPHA:
  5747. Format := tfLuminance8Alpha8us1;
  5748. PNG_COLOR_TYPE_RGB:
  5749. Format := tfRGB8ub3;
  5750. PNG_COLOR_TYPE_RGB_ALPHA:
  5751. Format := tfRGBA8ub4;
  5752. else
  5753. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5754. end;
  5755. // cut upper 8 bit from 16 bit formats
  5756. if png_get_bit_depth(png, png_info) > 8 then
  5757. png_set_strip_16(png);
  5758. // expand bitdepth smaller than 8
  5759. if png_get_bit_depth(png, png_info) < 8 then
  5760. png_set_expand(png);
  5761. // allocating mem for scanlines
  5762. LineSize := png_get_rowbytes(png, png_info);
  5763. GetMem(png_data, TempHeight * LineSize);
  5764. try
  5765. SetLength(png_rows, TempHeight);
  5766. for Row := Low(png_rows) to High(png_rows) do begin
  5767. png_rows[Row] := png_data;
  5768. Inc(png_rows[Row], Row * LineSize);
  5769. end;
  5770. // read complete image into scanlines
  5771. png_read_image(png, @png_rows[0]);
  5772. // read end
  5773. png_read_end(png, png_info);
  5774. // destroy read struct
  5775. png_destroy_read_struct(@png, @png_info, nil);
  5776. SetLength(png_rows, 0);
  5777. // set new data
  5778. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5779. result := true;
  5780. except
  5781. if Assigned(png_data) then
  5782. FreeMem(png_data);
  5783. raise;
  5784. end;
  5785. end;
  5786. finally
  5787. quit_libPNG;
  5788. end;
  5789. end;
  5790. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5791. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5792. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5793. var
  5794. StreamPos: Int64;
  5795. Png: TPNGObject;
  5796. Header: String[8];
  5797. Row, Col, PixSize, LineSize: Integer;
  5798. NewImage, pSource, pDest, pAlpha: pByte;
  5799. PngFormat: TglBitmapFormat;
  5800. FormatDesc: TFormatDescriptor;
  5801. const
  5802. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5803. begin
  5804. result := false;
  5805. StreamPos := aStream.Position;
  5806. aStream.Read(Header[0], SizeOf(Header));
  5807. aStream.Position := StreamPos;
  5808. {Test if the header matches}
  5809. if Header = PngHeader then begin
  5810. Png := TPNGObject.Create;
  5811. try
  5812. Png.LoadFromStream(aStream);
  5813. case Png.Header.ColorType of
  5814. COLOR_GRAYSCALE:
  5815. PngFormat := tfLuminance8ub1;
  5816. COLOR_GRAYSCALEALPHA:
  5817. PngFormat := tfLuminance8Alpha8us1;
  5818. COLOR_RGB:
  5819. PngFormat := tfBGR8ub3;
  5820. COLOR_RGBALPHA:
  5821. PngFormat := tfBGRA8ub4;
  5822. else
  5823. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5824. end;
  5825. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5826. PixSize := Round(FormatDesc.PixelSize);
  5827. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5828. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5829. try
  5830. pDest := NewImage;
  5831. case Png.Header.ColorType of
  5832. COLOR_RGB, COLOR_GRAYSCALE:
  5833. begin
  5834. for Row := 0 to Png.Height -1 do begin
  5835. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5836. Inc(pDest, LineSize);
  5837. end;
  5838. end;
  5839. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5840. begin
  5841. PixSize := PixSize -1;
  5842. for Row := 0 to Png.Height -1 do begin
  5843. pSource := Png.Scanline[Row];
  5844. pAlpha := pByte(Png.AlphaScanline[Row]);
  5845. for Col := 0 to Png.Width -1 do begin
  5846. Move (pSource^, pDest^, PixSize);
  5847. Inc(pSource, PixSize);
  5848. Inc(pDest, PixSize);
  5849. pDest^ := pAlpha^;
  5850. inc(pAlpha);
  5851. Inc(pDest);
  5852. end;
  5853. end;
  5854. end;
  5855. else
  5856. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5857. end;
  5858. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5859. result := true;
  5860. except
  5861. if Assigned(NewImage) then
  5862. FreeMem(NewImage);
  5863. raise;
  5864. end;
  5865. finally
  5866. Png.Free;
  5867. end;
  5868. end;
  5869. end;
  5870. {$IFEND}
  5871. {$ENDIF}
  5872. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5873. {$IFDEF GLB_LIB_PNG}
  5874. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5875. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5876. begin
  5877. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5878. end;
  5879. {$ENDIF}
  5880. {$IF DEFINED(GLB_LAZ_PNG)}
  5881. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5882. procedure TglBitmap.SavePNG(const aStream: TStream);
  5883. var
  5884. png: TPortableNetworkGraphic;
  5885. intf: TLazIntfImage;
  5886. raw: TRawImage;
  5887. begin
  5888. png := TPortableNetworkGraphic.Create;
  5889. intf := TLazIntfImage.Create(0, 0);
  5890. try
  5891. if not AssignToLazIntfImage(intf) then
  5892. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5893. intf.GetRawImage(raw);
  5894. png.LoadFromRawImage(raw, false);
  5895. png.SaveToStream(aStream);
  5896. finally
  5897. png.Free;
  5898. intf.Free;
  5899. end;
  5900. end;
  5901. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5903. procedure TglBitmap.SavePNG(const aStream: TStream);
  5904. var
  5905. png: png_structp;
  5906. png_info: png_infop;
  5907. png_rows: array of pByte;
  5908. LineSize: Integer;
  5909. ColorType: Integer;
  5910. Row: Integer;
  5911. FormatDesc: TFormatDescriptor;
  5912. begin
  5913. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5914. raise EglBitmapUnsupportedFormat.Create(Format);
  5915. if not init_libPNG then
  5916. raise Exception.Create('unable to initialize libPNG.');
  5917. try
  5918. case Format of
  5919. tfAlpha8ub1, tfLuminance8ub1:
  5920. ColorType := PNG_COLOR_TYPE_GRAY;
  5921. tfLuminance8Alpha8us1:
  5922. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5923. tfBGR8ub3, tfRGB8ub3:
  5924. ColorType := PNG_COLOR_TYPE_RGB;
  5925. tfBGRA8ub4, tfRGBA8ub4:
  5926. ColorType := PNG_COLOR_TYPE_RGBA;
  5927. else
  5928. raise EglBitmapUnsupportedFormat.Create(Format);
  5929. end;
  5930. FormatDesc := TFormatDescriptor.Get(Format);
  5931. LineSize := FormatDesc.GetSize(Width, 1);
  5932. // creating array for scanline
  5933. SetLength(png_rows, Height);
  5934. try
  5935. for Row := 0 to Height - 1 do begin
  5936. png_rows[Row] := Data;
  5937. Inc(png_rows[Row], Row * LineSize)
  5938. end;
  5939. // write struct
  5940. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5941. if png = nil then
  5942. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5943. // create png info
  5944. png_info := png_create_info_struct(png);
  5945. if png_info = nil then begin
  5946. png_destroy_write_struct(@png, nil);
  5947. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5948. end;
  5949. // set read callback
  5950. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5951. // set compression
  5952. png_set_compression_level(png, 6);
  5953. if Format in [tfBGR8ub3, tfBGRA8ub4] then
  5954. png_set_bgr(png);
  5955. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5956. png_write_info(png, png_info);
  5957. png_write_image(png, @png_rows[0]);
  5958. png_write_end(png, png_info);
  5959. png_destroy_write_struct(@png, @png_info);
  5960. finally
  5961. SetLength(png_rows, 0);
  5962. end;
  5963. finally
  5964. quit_libPNG;
  5965. end;
  5966. end;
  5967. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5969. procedure TglBitmap.SavePNG(const aStream: TStream);
  5970. var
  5971. Png: TPNGObject;
  5972. pSource, pDest: pByte;
  5973. X, Y, PixSize: Integer;
  5974. ColorType: Cardinal;
  5975. Alpha: Boolean;
  5976. pTemp: pByte;
  5977. Temp: Byte;
  5978. begin
  5979. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5980. raise EglBitmapUnsupportedFormat.Create(Format);
  5981. case Format of
  5982. tfAlpha8ub1, tfLuminance8ub1: begin
  5983. ColorType := COLOR_GRAYSCALE;
  5984. PixSize := 1;
  5985. Alpha := false;
  5986. end;
  5987. tfLuminance8Alpha8us1: begin
  5988. ColorType := COLOR_GRAYSCALEALPHA;
  5989. PixSize := 1;
  5990. Alpha := true;
  5991. end;
  5992. tfBGR8ub3, tfRGB8ub3: begin
  5993. ColorType := COLOR_RGB;
  5994. PixSize := 3;
  5995. Alpha := false;
  5996. end;
  5997. tfBGRA8ub4, tfRGBA8ub4: begin
  5998. ColorType := COLOR_RGBALPHA;
  5999. PixSize := 3;
  6000. Alpha := true
  6001. end;
  6002. else
  6003. raise EglBitmapUnsupportedFormat.Create(Format);
  6004. end;
  6005. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  6006. try
  6007. // Copy ImageData
  6008. pSource := Data;
  6009. for Y := 0 to Height -1 do begin
  6010. pDest := png.ScanLine[Y];
  6011. for X := 0 to Width -1 do begin
  6012. Move(pSource^, pDest^, PixSize);
  6013. Inc(pDest, PixSize);
  6014. Inc(pSource, PixSize);
  6015. if Alpha then begin
  6016. png.AlphaScanline[Y]^[X] := pSource^;
  6017. Inc(pSource);
  6018. end;
  6019. end;
  6020. // convert RGB line to BGR
  6021. if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
  6022. pTemp := png.ScanLine[Y];
  6023. for X := 0 to Width -1 do begin
  6024. Temp := pByteArray(pTemp)^[0];
  6025. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  6026. pByteArray(pTemp)^[2] := Temp;
  6027. Inc(pTemp, 3);
  6028. end;
  6029. end;
  6030. end;
  6031. // Save to Stream
  6032. Png.CompressionLevel := 6;
  6033. Png.SaveToStream(aStream);
  6034. finally
  6035. FreeAndNil(Png);
  6036. end;
  6037. end;
  6038. {$IFEND}
  6039. {$ENDIF}
  6040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6041. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6042. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6043. {$IFDEF GLB_LIB_JPEG}
  6044. type
  6045. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  6046. glBitmap_libJPEG_source_mgr = record
  6047. pub: jpeg_source_mgr;
  6048. SrcStream: TStream;
  6049. SrcBuffer: array [1..4096] of byte;
  6050. end;
  6051. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  6052. glBitmap_libJPEG_dest_mgr = record
  6053. pub: jpeg_destination_mgr;
  6054. DestStream: TStream;
  6055. DestBuffer: array [1..4096] of byte;
  6056. end;
  6057. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  6058. begin
  6059. //DUMMY
  6060. end;
  6061. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  6062. begin
  6063. //DUMMY
  6064. end;
  6065. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  6066. begin
  6067. //DUMMY
  6068. end;
  6069. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  6070. begin
  6071. //DUMMY
  6072. end;
  6073. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  6074. begin
  6075. //DUMMY
  6076. end;
  6077. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6078. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  6079. var
  6080. src: glBitmap_libJPEG_source_mgr_ptr;
  6081. bytes: integer;
  6082. begin
  6083. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  6084. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  6085. if (bytes <= 0) then begin
  6086. src^.SrcBuffer[1] := $FF;
  6087. src^.SrcBuffer[2] := JPEG_EOI;
  6088. bytes := 2;
  6089. end;
  6090. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  6091. src^.pub.bytes_in_buffer := bytes;
  6092. result := true;
  6093. end;
  6094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6095. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  6096. var
  6097. src: glBitmap_libJPEG_source_mgr_ptr;
  6098. begin
  6099. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  6100. if num_bytes > 0 then begin
  6101. // wanted byte isn't in buffer so set stream position and read buffer
  6102. if num_bytes > src^.pub.bytes_in_buffer then begin
  6103. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  6104. src^.pub.fill_input_buffer(cinfo);
  6105. end else begin
  6106. // wanted byte is in buffer so only skip
  6107. inc(src^.pub.next_input_byte, num_bytes);
  6108. dec(src^.pub.bytes_in_buffer, num_bytes);
  6109. end;
  6110. end;
  6111. end;
  6112. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6113. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  6114. var
  6115. dest: glBitmap_libJPEG_dest_mgr_ptr;
  6116. begin
  6117. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  6118. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  6119. // write complete buffer
  6120. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  6121. // reset buffer
  6122. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  6123. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  6124. end;
  6125. result := true;
  6126. end;
  6127. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6128. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  6129. var
  6130. Idx: Integer;
  6131. dest: glBitmap_libJPEG_dest_mgr_ptr;
  6132. begin
  6133. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  6134. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  6135. // check for endblock
  6136. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  6137. // write endblock
  6138. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  6139. // leave
  6140. break;
  6141. end else
  6142. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  6143. end;
  6144. end;
  6145. {$ENDIF}
  6146. {$IFDEF GLB_SUPPORT_JPEG_READ}
  6147. {$IF DEFINED(GLB_LAZ_JPEG)}
  6148. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6149. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6150. const
  6151. MAGIC_LEN = 2;
  6152. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  6153. var
  6154. intf: TLazIntfImage;
  6155. reader: TFPReaderJPEG;
  6156. StreamPos: Int64;
  6157. magic: String[MAGIC_LEN];
  6158. begin
  6159. result := true;
  6160. StreamPos := aStream.Position;
  6161. SetLength(magic, MAGIC_LEN);
  6162. aStream.Read(magic[1], MAGIC_LEN);
  6163. aStream.Position := StreamPos;
  6164. if (magic <> JPEG_MAGIC) then begin
  6165. result := false;
  6166. exit;
  6167. end;
  6168. reader := TFPReaderJPEG.Create;
  6169. intf := TLazIntfImage.Create(0, 0);
  6170. try try
  6171. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  6172. reader.ImageRead(aStream, intf);
  6173. AssignFromLazIntfImage(intf);
  6174. except
  6175. result := false;
  6176. aStream.Position := StreamPos;
  6177. exit;
  6178. end;
  6179. finally
  6180. reader.Free;
  6181. intf.Free;
  6182. end;
  6183. end;
  6184. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  6185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6186. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6187. var
  6188. Surface: PSDL_Surface;
  6189. RWops: PSDL_RWops;
  6190. begin
  6191. result := false;
  6192. RWops := glBitmapCreateRWops(aStream);
  6193. try
  6194. if IMG_isJPG(RWops) > 0 then begin
  6195. Surface := IMG_LoadJPG_RW(RWops);
  6196. try
  6197. AssignFromSurface(Surface);
  6198. result := true;
  6199. finally
  6200. SDL_FreeSurface(Surface);
  6201. end;
  6202. end;
  6203. finally
  6204. SDL_FreeRW(RWops);
  6205. end;
  6206. end;
  6207. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  6208. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6209. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6210. var
  6211. StreamPos: Int64;
  6212. Temp: array[0..1]of Byte;
  6213. jpeg: jpeg_decompress_struct;
  6214. jpeg_err: jpeg_error_mgr;
  6215. IntFormat: TglBitmapFormat;
  6216. pImage: pByte;
  6217. TempHeight, TempWidth: Integer;
  6218. pTemp: pByte;
  6219. Row: Integer;
  6220. FormatDesc: TFormatDescriptor;
  6221. begin
  6222. result := false;
  6223. if not init_libJPEG then
  6224. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  6225. try
  6226. // reading first two bytes to test file and set cursor back to begin
  6227. StreamPos := aStream.Position;
  6228. aStream.Read({%H-}Temp[0], 2);
  6229. aStream.Position := StreamPos;
  6230. // if Bitmap then read file.
  6231. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  6232. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  6233. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  6234. // error managment
  6235. jpeg.err := jpeg_std_error(@jpeg_err);
  6236. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  6237. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  6238. // decompression struct
  6239. jpeg_create_decompress(@jpeg);
  6240. // allocation space for streaming methods
  6241. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  6242. // seeting up custom functions
  6243. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  6244. pub.init_source := glBitmap_libJPEG_init_source;
  6245. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  6246. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  6247. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  6248. pub.term_source := glBitmap_libJPEG_term_source;
  6249. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  6250. pub.next_input_byte := nil; // until buffer loaded
  6251. SrcStream := aStream;
  6252. end;
  6253. // set global decoding state
  6254. jpeg.global_state := DSTATE_START;
  6255. // read header of jpeg
  6256. jpeg_read_header(@jpeg, false);
  6257. // setting output parameter
  6258. case jpeg.jpeg_color_space of
  6259. JCS_GRAYSCALE:
  6260. begin
  6261. jpeg.out_color_space := JCS_GRAYSCALE;
  6262. IntFormat := tfLuminance8ub1;
  6263. end;
  6264. else
  6265. jpeg.out_color_space := JCS_RGB;
  6266. IntFormat := tfRGB8ub3;
  6267. end;
  6268. // reading image
  6269. jpeg_start_decompress(@jpeg);
  6270. TempHeight := jpeg.output_height;
  6271. TempWidth := jpeg.output_width;
  6272. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6273. // creating new image
  6274. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  6275. try
  6276. pTemp := pImage;
  6277. for Row := 0 to TempHeight -1 do begin
  6278. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  6279. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  6280. end;
  6281. // finish decompression
  6282. jpeg_finish_decompress(@jpeg);
  6283. // destroy decompression
  6284. jpeg_destroy_decompress(@jpeg);
  6285. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  6286. result := true;
  6287. except
  6288. if Assigned(pImage) then
  6289. FreeMem(pImage);
  6290. raise;
  6291. end;
  6292. end;
  6293. finally
  6294. quit_libJPEG;
  6295. end;
  6296. end;
  6297. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  6298. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6299. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6300. var
  6301. bmp: TBitmap;
  6302. jpg: TJPEGImage;
  6303. StreamPos: Int64;
  6304. Temp: array[0..1]of Byte;
  6305. begin
  6306. result := false;
  6307. // reading first two bytes to test file and set cursor back to begin
  6308. StreamPos := aStream.Position;
  6309. aStream.Read(Temp[0], 2);
  6310. aStream.Position := StreamPos;
  6311. // if Bitmap then read file.
  6312. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  6313. bmp := TBitmap.Create;
  6314. try
  6315. jpg := TJPEGImage.Create;
  6316. try
  6317. jpg.LoadFromStream(aStream);
  6318. bmp.Assign(jpg);
  6319. result := AssignFromBitmap(bmp);
  6320. finally
  6321. jpg.Free;
  6322. end;
  6323. finally
  6324. bmp.Free;
  6325. end;
  6326. end;
  6327. end;
  6328. {$IFEND}
  6329. {$ENDIF}
  6330. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  6331. {$IF DEFINED(GLB_LAZ_JPEG)}
  6332. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6333. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6334. var
  6335. jpeg: TJPEGImage;
  6336. intf: TLazIntfImage;
  6337. raw: TRawImage;
  6338. begin
  6339. jpeg := TJPEGImage.Create;
  6340. intf := TLazIntfImage.Create(0, 0);
  6341. try
  6342. if not AssignToLazIntfImage(intf) then
  6343. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  6344. intf.GetRawImage(raw);
  6345. jpeg.LoadFromRawImage(raw, false);
  6346. jpeg.SaveToStream(aStream);
  6347. finally
  6348. intf.Free;
  6349. jpeg.Free;
  6350. end;
  6351. end;
  6352. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  6353. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6354. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6355. var
  6356. jpeg: jpeg_compress_struct;
  6357. jpeg_err: jpeg_error_mgr;
  6358. Row: Integer;
  6359. pTemp, pTemp2: pByte;
  6360. procedure CopyRow(pDest, pSource: pByte);
  6361. var
  6362. X: Integer;
  6363. begin
  6364. for X := 0 to Width - 1 do begin
  6365. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  6366. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  6367. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  6368. Inc(pDest, 3);
  6369. Inc(pSource, 3);
  6370. end;
  6371. end;
  6372. begin
  6373. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6374. raise EglBitmapUnsupportedFormat.Create(Format);
  6375. if not init_libJPEG then
  6376. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  6377. try
  6378. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  6379. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  6380. // error managment
  6381. jpeg.err := jpeg_std_error(@jpeg_err);
  6382. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  6383. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  6384. // compression struct
  6385. jpeg_create_compress(@jpeg);
  6386. // allocation space for streaming methods
  6387. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  6388. // seeting up custom functions
  6389. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  6390. pub.init_destination := glBitmap_libJPEG_init_destination;
  6391. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  6392. pub.term_destination := glBitmap_libJPEG_term_destination;
  6393. pub.next_output_byte := @DestBuffer[1];
  6394. pub.free_in_buffer := Length(DestBuffer);
  6395. DestStream := aStream;
  6396. end;
  6397. // very important state
  6398. jpeg.global_state := CSTATE_START;
  6399. jpeg.image_width := Width;
  6400. jpeg.image_height := Height;
  6401. case Format of
  6402. tfAlpha8ub1, tfLuminance8ub1: begin
  6403. jpeg.input_components := 1;
  6404. jpeg.in_color_space := JCS_GRAYSCALE;
  6405. end;
  6406. tfRGB8ub3, tfBGR8ub3: begin
  6407. jpeg.input_components := 3;
  6408. jpeg.in_color_space := JCS_RGB;
  6409. end;
  6410. end;
  6411. jpeg_set_defaults(@jpeg);
  6412. jpeg_set_quality(@jpeg, 95, true);
  6413. jpeg_start_compress(@jpeg, true);
  6414. pTemp := Data;
  6415. if Format = tfBGR8ub3 then
  6416. GetMem(pTemp2, fRowSize)
  6417. else
  6418. pTemp2 := pTemp;
  6419. try
  6420. for Row := 0 to jpeg.image_height -1 do begin
  6421. // prepare row
  6422. if Format = tfBGR8ub3 then
  6423. CopyRow(pTemp2, pTemp)
  6424. else
  6425. pTemp2 := pTemp;
  6426. // write row
  6427. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  6428. inc(pTemp, fRowSize);
  6429. end;
  6430. finally
  6431. // free memory
  6432. if Format = tfBGR8ub3 then
  6433. FreeMem(pTemp2);
  6434. end;
  6435. jpeg_finish_compress(@jpeg);
  6436. jpeg_destroy_compress(@jpeg);
  6437. finally
  6438. quit_libJPEG;
  6439. end;
  6440. end;
  6441. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  6442. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6443. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6444. var
  6445. Bmp: TBitmap;
  6446. Jpg: TJPEGImage;
  6447. begin
  6448. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6449. raise EglBitmapUnsupportedFormat.Create(Format);
  6450. Bmp := TBitmap.Create;
  6451. try
  6452. Jpg := TJPEGImage.Create;
  6453. try
  6454. AssignToBitmap(Bmp);
  6455. if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
  6456. Jpg.Grayscale := true;
  6457. Jpg.PixelFormat := jf8Bit;
  6458. end;
  6459. Jpg.Assign(Bmp);
  6460. Jpg.SaveToStream(aStream);
  6461. finally
  6462. FreeAndNil(Jpg);
  6463. end;
  6464. finally
  6465. FreeAndNil(Bmp);
  6466. end;
  6467. end;
  6468. {$IFEND}
  6469. {$ENDIF}
  6470. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6471. //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6473. type
  6474. RawHeader = packed record
  6475. Magic: String[5];
  6476. Version: Byte;
  6477. Width: Integer;
  6478. Height: Integer;
  6479. DataSize: Integer;
  6480. BitsPerPixel: Integer;
  6481. Precision: TglBitmapRec4ub;
  6482. Shift: TglBitmapRec4ub;
  6483. end;
  6484. function TglBitmap.LoadRAW(const aStream: TStream): Boolean;
  6485. var
  6486. header: RawHeader;
  6487. StartPos: Int64;
  6488. fd: TFormatDescriptor;
  6489. buf: PByte;
  6490. begin
  6491. result := false;
  6492. StartPos := aStream.Position;
  6493. aStream.Read(header{%H-}, SizeOf(header));
  6494. if (header.Magic <> 'glBMP') then begin
  6495. aStream.Position := StartPos;
  6496. exit;
  6497. end;
  6498. fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
  6499. if (fd.Format = tfEmpty) then
  6500. raise EglBitmapUnsupportedFormat.Create('no supported format found');
  6501. buf := GetMemory(header.DataSize);
  6502. aStream.Read(buf^, header.DataSize);
  6503. SetDataPointer(buf, fd.Format, header.Width, header.Height);
  6504. result := true;
  6505. end;
  6506. procedure TglBitmap.SaveRAW(const aStream: TStream);
  6507. var
  6508. header: RawHeader;
  6509. fd: TFormatDescriptor;
  6510. begin
  6511. fd := TFormatDescriptor.Get(Format);
  6512. header.Magic := 'glBMP';
  6513. header.Version := 1;
  6514. header.Width := Width;
  6515. header.Height := Height;
  6516. header.DataSize := fd.GetSize(fDimension);
  6517. header.BitsPerPixel := fd.BitsPerPixel;
  6518. header.Precision := fd.Precision;
  6519. header.Shift := fd.Shift;
  6520. aStream.Write(header, SizeOf(header));
  6521. aStream.Write(Data^, header.DataSize);
  6522. end;
  6523. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6524. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6525. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6526. const
  6527. BMP_MAGIC = $4D42;
  6528. BMP_COMP_RGB = 0;
  6529. BMP_COMP_RLE8 = 1;
  6530. BMP_COMP_RLE4 = 2;
  6531. BMP_COMP_BITFIELDS = 3;
  6532. type
  6533. TBMPHeader = packed record
  6534. bfType: Word;
  6535. bfSize: Cardinal;
  6536. bfReserved1: Word;
  6537. bfReserved2: Word;
  6538. bfOffBits: Cardinal;
  6539. end;
  6540. TBMPInfo = packed record
  6541. biSize: Cardinal;
  6542. biWidth: Longint;
  6543. biHeight: Longint;
  6544. biPlanes: Word;
  6545. biBitCount: Word;
  6546. biCompression: Cardinal;
  6547. biSizeImage: Cardinal;
  6548. biXPelsPerMeter: Longint;
  6549. biYPelsPerMeter: Longint;
  6550. biClrUsed: Cardinal;
  6551. biClrImportant: Cardinal;
  6552. end;
  6553. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6554. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  6555. //////////////////////////////////////////////////////////////////////////////////////////////////
  6556. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
  6557. begin
  6558. result := tfEmpty;
  6559. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  6560. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  6561. //Read Compression
  6562. case aInfo.biCompression of
  6563. BMP_COMP_RLE4,
  6564. BMP_COMP_RLE8: begin
  6565. raise EglBitmap.Create('RLE compression is not supported');
  6566. end;
  6567. BMP_COMP_BITFIELDS: begin
  6568. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  6569. aStream.Read(aMask.r, SizeOf(aMask.r));
  6570. aStream.Read(aMask.g, SizeOf(aMask.g));
  6571. aStream.Read(aMask.b, SizeOf(aMask.b));
  6572. aStream.Read(aMask.a, SizeOf(aMask.a));
  6573. end else
  6574. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  6575. end;
  6576. end;
  6577. //get suitable format
  6578. case aInfo.biBitCount of
  6579. 8: result := tfLuminance8ub1;
  6580. 16: result := tfX1RGB5us1;
  6581. 24: result := tfBGR8ub3;
  6582. 32: result := tfXRGB8ui1;
  6583. end;
  6584. end;
  6585. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  6586. var
  6587. i, c: Integer;
  6588. ColorTable: TbmpColorTable;
  6589. begin
  6590. result := nil;
  6591. if (aInfo.biBitCount >= 16) then
  6592. exit;
  6593. aFormat := tfLuminance8ub1;
  6594. c := aInfo.biClrUsed;
  6595. if (c = 0) then
  6596. c := 1 shl aInfo.biBitCount;
  6597. SetLength(ColorTable, c);
  6598. for i := 0 to c-1 do begin
  6599. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  6600. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  6601. aFormat := tfRGB8ub3;
  6602. end;
  6603. result := TbmpColorTableFormat.Create;
  6604. result.BitsPerPixel := aInfo.biBitCount;
  6605. result.ColorTable := ColorTable;
  6606. result.CalcValues;
  6607. end;
  6608. //////////////////////////////////////////////////////////////////////////////////////////////////
  6609. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
  6610. var
  6611. FormatDesc: TFormatDescriptor;
  6612. begin
  6613. result := nil;
  6614. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  6615. FormatDesc := TFormatDescriptor.GetFromMask(aMask);
  6616. if (FormatDesc.Format = tfEmpty) then
  6617. exit;
  6618. aFormat := FormatDesc.Format;
  6619. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  6620. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  6621. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  6622. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  6623. result := TbmpBitfieldFormat.Create;
  6624. result.SetCustomValues(aInfo.biBitCount, aMask);
  6625. end;
  6626. end;
  6627. var
  6628. //simple types
  6629. StartPos: Int64;
  6630. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  6631. PaddingBuff: Cardinal;
  6632. LineBuf, ImageData, TmpData: PByte;
  6633. SourceMD, DestMD: Pointer;
  6634. BmpFormat: TglBitmapFormat;
  6635. //records
  6636. Mask: TglBitmapRec4ul;
  6637. Header: TBMPHeader;
  6638. Info: TBMPInfo;
  6639. //classes
  6640. SpecialFormat: TFormatDescriptor;
  6641. FormatDesc: TFormatDescriptor;
  6642. //////////////////////////////////////////////////////////////////////////////////////////////////
  6643. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  6644. var
  6645. i: Integer;
  6646. Pixel: TglBitmapPixelData;
  6647. begin
  6648. aStream.Read(aLineBuf^, rbLineSize);
  6649. SpecialFormat.PreparePixel(Pixel);
  6650. for i := 0 to Info.biWidth-1 do begin
  6651. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  6652. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  6653. FormatDesc.Map(Pixel, aData, DestMD);
  6654. end;
  6655. end;
  6656. begin
  6657. result := false;
  6658. BmpFormat := tfEmpty;
  6659. SpecialFormat := nil;
  6660. LineBuf := nil;
  6661. SourceMD := nil;
  6662. DestMD := nil;
  6663. // Header
  6664. StartPos := aStream.Position;
  6665. aStream.Read(Header{%H-}, SizeOf(Header));
  6666. if Header.bfType = BMP_MAGIC then begin
  6667. try try
  6668. BmpFormat := ReadInfo(Info, Mask);
  6669. SpecialFormat := ReadColorTable(BmpFormat, Info);
  6670. if not Assigned(SpecialFormat) then
  6671. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  6672. aStream.Position := StartPos + Header.bfOffBits;
  6673. if (BmpFormat <> tfEmpty) then begin
  6674. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  6675. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  6676. wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
  6677. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  6678. //get Memory
  6679. DestMD := FormatDesc.CreateMappingData;
  6680. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  6681. GetMem(ImageData, ImageSize);
  6682. if Assigned(SpecialFormat) then begin
  6683. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  6684. SourceMD := SpecialFormat.CreateMappingData;
  6685. end;
  6686. //read Data
  6687. try try
  6688. FillChar(ImageData^, ImageSize, $FF);
  6689. TmpData := ImageData;
  6690. if (Info.biHeight > 0) then
  6691. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  6692. for i := 0 to Abs(Info.biHeight)-1 do begin
  6693. if Assigned(SpecialFormat) then
  6694. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  6695. else
  6696. aStream.Read(TmpData^, wbLineSize); //else only read data
  6697. if (Info.biHeight > 0) then
  6698. dec(TmpData, wbLineSize)
  6699. else
  6700. inc(TmpData, wbLineSize);
  6701. aStream.Read(PaddingBuff{%H-}, Padding);
  6702. end;
  6703. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6704. result := true;
  6705. finally
  6706. if Assigned(LineBuf) then
  6707. FreeMem(LineBuf);
  6708. if Assigned(SourceMD) then
  6709. SpecialFormat.FreeMappingData(SourceMD);
  6710. FormatDesc.FreeMappingData(DestMD);
  6711. end;
  6712. except
  6713. if Assigned(ImageData) then
  6714. FreeMem(ImageData);
  6715. raise;
  6716. end;
  6717. end else
  6718. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6719. except
  6720. aStream.Position := StartPos;
  6721. raise;
  6722. end;
  6723. finally
  6724. FreeAndNil(SpecialFormat);
  6725. end;
  6726. end
  6727. else aStream.Position := StartPos;
  6728. end;
  6729. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6730. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6731. var
  6732. Header: TBMPHeader;
  6733. Info: TBMPInfo;
  6734. Converter: TFormatDescriptor;
  6735. FormatDesc: TFormatDescriptor;
  6736. SourceFD, DestFD: Pointer;
  6737. pData, srcData, dstData, ConvertBuffer: pByte;
  6738. Pixel: TglBitmapPixelData;
  6739. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6740. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6741. PaddingBuff: Cardinal;
  6742. function GetLineWidth : Integer;
  6743. begin
  6744. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6745. end;
  6746. begin
  6747. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6748. raise EglBitmapUnsupportedFormat.Create(Format);
  6749. Converter := nil;
  6750. FormatDesc := TFormatDescriptor.Get(Format);
  6751. ImageSize := FormatDesc.GetSize(Dimension);
  6752. FillChar(Header{%H-}, SizeOf(Header), 0);
  6753. Header.bfType := BMP_MAGIC;
  6754. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6755. Header.bfReserved1 := 0;
  6756. Header.bfReserved2 := 0;
  6757. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6758. FillChar(Info{%H-}, SizeOf(Info), 0);
  6759. Info.biSize := SizeOf(Info);
  6760. Info.biWidth := Width;
  6761. Info.biHeight := Height;
  6762. Info.biPlanes := 1;
  6763. Info.biCompression := BMP_COMP_RGB;
  6764. Info.biSizeImage := ImageSize;
  6765. try
  6766. case Format of
  6767. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
  6768. begin
  6769. Info.biBitCount := 8;
  6770. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6771. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6772. Converter := TbmpColorTableFormat.Create;
  6773. with (Converter as TbmpColorTableFormat) do begin
  6774. SetCustomValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift);
  6775. CreateColorTable;
  6776. end;
  6777. end;
  6778. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  6779. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  6780. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
  6781. begin
  6782. Info.biBitCount := 16;
  6783. Info.biCompression := BMP_COMP_BITFIELDS;
  6784. end;
  6785. tfBGR8ub3, tfRGB8ub3:
  6786. begin
  6787. Info.biBitCount := 24;
  6788. if (Format = tfRGB8ub3) then
  6789. Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6790. end;
  6791. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  6792. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
  6793. begin
  6794. Info.biBitCount := 32;
  6795. Info.biCompression := BMP_COMP_BITFIELDS;
  6796. end;
  6797. else
  6798. raise EglBitmapUnsupportedFormat.Create(Format);
  6799. end;
  6800. Info.biXPelsPerMeter := 2835;
  6801. Info.biYPelsPerMeter := 2835;
  6802. // prepare bitmasks
  6803. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6804. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6805. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6806. RedMask := FormatDesc.Mask.r;
  6807. GreenMask := FormatDesc.Mask.g;
  6808. BlueMask := FormatDesc.Mask.b;
  6809. AlphaMask := FormatDesc.Mask.a;
  6810. end;
  6811. // headers
  6812. aStream.Write(Header, SizeOf(Header));
  6813. aStream.Write(Info, SizeOf(Info));
  6814. // colortable
  6815. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6816. with (Converter as TbmpColorTableFormat) do
  6817. aStream.Write(ColorTable[0].b,
  6818. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6819. // bitmasks
  6820. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6821. aStream.Write(RedMask, SizeOf(Cardinal));
  6822. aStream.Write(GreenMask, SizeOf(Cardinal));
  6823. aStream.Write(BlueMask, SizeOf(Cardinal));
  6824. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6825. end;
  6826. // image data
  6827. rbLineSize := Round(Info.biWidth * FormatDesc.BytesPerPixel);
  6828. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6829. Padding := GetLineWidth - wbLineSize;
  6830. PaddingBuff := 0;
  6831. pData := Data;
  6832. inc(pData, (Height-1) * rbLineSize);
  6833. // prepare row buffer. But only for RGB because RGBA supports color masks
  6834. // so it's possible to change color within the image.
  6835. if Assigned(Converter) then begin
  6836. FormatDesc.PreparePixel(Pixel);
  6837. GetMem(ConvertBuffer, wbLineSize);
  6838. SourceFD := FormatDesc.CreateMappingData;
  6839. DestFD := Converter.CreateMappingData;
  6840. end else
  6841. ConvertBuffer := nil;
  6842. try
  6843. for LineIdx := 0 to Height - 1 do begin
  6844. // preparing row
  6845. if Assigned(Converter) then begin
  6846. srcData := pData;
  6847. dstData := ConvertBuffer;
  6848. for PixelIdx := 0 to Info.biWidth-1 do begin
  6849. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6850. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6851. Converter.Map(Pixel, dstData, DestFD);
  6852. end;
  6853. aStream.Write(ConvertBuffer^, wbLineSize);
  6854. end else begin
  6855. aStream.Write(pData^, rbLineSize);
  6856. end;
  6857. dec(pData, rbLineSize);
  6858. if (Padding > 0) then
  6859. aStream.Write(PaddingBuff, Padding);
  6860. end;
  6861. finally
  6862. // destroy row buffer
  6863. if Assigned(ConvertBuffer) then begin
  6864. FormatDesc.FreeMappingData(SourceFD);
  6865. Converter.FreeMappingData(DestFD);
  6866. FreeMem(ConvertBuffer);
  6867. end;
  6868. end;
  6869. finally
  6870. if Assigned(Converter) then
  6871. Converter.Free;
  6872. end;
  6873. end;
  6874. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6875. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6876. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6877. type
  6878. TTGAHeader = packed record
  6879. ImageID: Byte;
  6880. ColorMapType: Byte;
  6881. ImageType: Byte;
  6882. //ColorMapSpec: Array[0..4] of Byte;
  6883. ColorMapStart: Word;
  6884. ColorMapLength: Word;
  6885. ColorMapEntrySize: Byte;
  6886. OrigX: Word;
  6887. OrigY: Word;
  6888. Width: Word;
  6889. Height: Word;
  6890. Bpp: Byte;
  6891. ImageDesc: Byte;
  6892. end;
  6893. const
  6894. TGA_UNCOMPRESSED_RGB = 2;
  6895. TGA_UNCOMPRESSED_GRAY = 3;
  6896. TGA_COMPRESSED_RGB = 10;
  6897. TGA_COMPRESSED_GRAY = 11;
  6898. TGA_NONE_COLOR_TABLE = 0;
  6899. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6900. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6901. var
  6902. Header: TTGAHeader;
  6903. ImageData: System.PByte;
  6904. StartPosition: Int64;
  6905. PixelSize, LineSize: Integer;
  6906. tgaFormat: TglBitmapFormat;
  6907. FormatDesc: TFormatDescriptor;
  6908. Counter: packed record
  6909. X, Y: packed record
  6910. low, high, dir: Integer;
  6911. end;
  6912. end;
  6913. const
  6914. CACHE_SIZE = $4000;
  6915. ////////////////////////////////////////////////////////////////////////////////////////
  6916. procedure ReadUncompressed;
  6917. var
  6918. i, j: Integer;
  6919. buf, tmp1, tmp2: System.PByte;
  6920. begin
  6921. buf := nil;
  6922. if (Counter.X.dir < 0) then
  6923. GetMem(buf, LineSize);
  6924. try
  6925. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6926. tmp1 := ImageData;
  6927. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6928. if (Counter.X.dir < 0) then begin //flip X
  6929. aStream.Read(buf^, LineSize);
  6930. tmp2 := buf;
  6931. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6932. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6933. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6934. tmp1^ := tmp2^;
  6935. inc(tmp1);
  6936. inc(tmp2);
  6937. end;
  6938. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6939. end;
  6940. end else
  6941. aStream.Read(tmp1^, LineSize);
  6942. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6943. end;
  6944. finally
  6945. if Assigned(buf) then
  6946. FreeMem(buf);
  6947. end;
  6948. end;
  6949. ////////////////////////////////////////////////////////////////////////////////////////
  6950. procedure ReadCompressed;
  6951. /////////////////////////////////////////////////////////////////
  6952. var
  6953. TmpData: System.PByte;
  6954. LinePixelsRead: Integer;
  6955. procedure CheckLine;
  6956. begin
  6957. if (LinePixelsRead >= Header.Width) then begin
  6958. LinePixelsRead := 0;
  6959. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6960. TmpData := ImageData;
  6961. inc(TmpData, Counter.Y.low * LineSize); //set line
  6962. if (Counter.X.dir < 0) then //if x flipped then
  6963. inc(TmpData, LineSize - PixelSize); //set last pixel
  6964. end;
  6965. end;
  6966. /////////////////////////////////////////////////////////////////
  6967. var
  6968. Cache: PByte;
  6969. CacheSize, CachePos: Integer;
  6970. procedure CachedRead(out Buffer; Count: Integer);
  6971. var
  6972. BytesRead: Integer;
  6973. begin
  6974. if (CachePos + Count > CacheSize) then begin
  6975. //if buffer overflow save non read bytes
  6976. BytesRead := 0;
  6977. if (CacheSize - CachePos > 0) then begin
  6978. BytesRead := CacheSize - CachePos;
  6979. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6980. inc(CachePos, BytesRead);
  6981. end;
  6982. //load cache from file
  6983. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6984. aStream.Read(Cache^, CacheSize);
  6985. CachePos := 0;
  6986. //read rest of requested bytes
  6987. if (Count - BytesRead > 0) then begin
  6988. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6989. inc(CachePos, Count - BytesRead);
  6990. end;
  6991. end else begin
  6992. //if no buffer overflow just read the data
  6993. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6994. inc(CachePos, Count);
  6995. end;
  6996. end;
  6997. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6998. begin
  6999. case PixelSize of
  7000. 1: begin
  7001. aBuffer^ := aData^;
  7002. inc(aBuffer, Counter.X.dir);
  7003. end;
  7004. 2: begin
  7005. PWord(aBuffer)^ := PWord(aData)^;
  7006. inc(aBuffer, 2 * Counter.X.dir);
  7007. end;
  7008. 3: begin
  7009. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  7010. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  7011. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  7012. inc(aBuffer, 3 * Counter.X.dir);
  7013. end;
  7014. 4: begin
  7015. PCardinal(aBuffer)^ := PCardinal(aData)^;
  7016. inc(aBuffer, 4 * Counter.X.dir);
  7017. end;
  7018. end;
  7019. end;
  7020. var
  7021. TotalPixelsToRead, TotalPixelsRead: Integer;
  7022. Temp: Byte;
  7023. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  7024. PixelRepeat: Boolean;
  7025. PixelsToRead, PixelCount: Integer;
  7026. begin
  7027. CacheSize := 0;
  7028. CachePos := 0;
  7029. TotalPixelsToRead := Header.Width * Header.Height;
  7030. TotalPixelsRead := 0;
  7031. LinePixelsRead := 0;
  7032. GetMem(Cache, CACHE_SIZE);
  7033. try
  7034. TmpData := ImageData;
  7035. inc(TmpData, Counter.Y.low * LineSize); //set line
  7036. if (Counter.X.dir < 0) then //if x flipped then
  7037. inc(TmpData, LineSize - PixelSize); //set last pixel
  7038. repeat
  7039. //read CommandByte
  7040. CachedRead(Temp, 1);
  7041. PixelRepeat := (Temp and $80) > 0;
  7042. PixelsToRead := (Temp and $7F) + 1;
  7043. inc(TotalPixelsRead, PixelsToRead);
  7044. if PixelRepeat then
  7045. CachedRead(buf[0], PixelSize);
  7046. while (PixelsToRead > 0) do begin
  7047. CheckLine;
  7048. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  7049. while (PixelCount > 0) do begin
  7050. if not PixelRepeat then
  7051. CachedRead(buf[0], PixelSize);
  7052. PixelToBuffer(@buf[0], TmpData);
  7053. inc(LinePixelsRead);
  7054. dec(PixelsToRead);
  7055. dec(PixelCount);
  7056. end;
  7057. end;
  7058. until (TotalPixelsRead >= TotalPixelsToRead);
  7059. finally
  7060. FreeMem(Cache);
  7061. end;
  7062. end;
  7063. function IsGrayFormat: Boolean;
  7064. begin
  7065. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  7066. end;
  7067. begin
  7068. result := false;
  7069. // reading header to test file and set cursor back to begin
  7070. StartPosition := aStream.Position;
  7071. aStream.Read(Header{%H-}, SizeOf(Header));
  7072. // no colormapped files
  7073. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  7074. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  7075. begin
  7076. try
  7077. if Header.ImageID <> 0 then // skip image ID
  7078. aStream.Position := aStream.Position + Header.ImageID;
  7079. tgaFormat := tfEmpty;
  7080. case Header.Bpp of
  7081. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  7082. 0: tgaFormat := tfLuminance8ub1;
  7083. 8: tgaFormat := tfAlpha8ub1;
  7084. end;
  7085. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  7086. 0: tgaFormat := tfLuminance16us1;
  7087. 8: tgaFormat := tfLuminance8Alpha8ub2;
  7088. end else case (Header.ImageDesc and $F) of
  7089. 0: tgaFormat := tfX1RGB5us1;
  7090. 1: tgaFormat := tfA1RGB5us1;
  7091. 4: tgaFormat := tfARGB4us1;
  7092. end;
  7093. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  7094. 0: tgaFormat := tfBGR8ub3;
  7095. end;
  7096. 32: if IsGrayFormat then case (Header.ImageDesc and $F) of
  7097. 0: tgaFormat := tfDepth32ui1;
  7098. end else case (Header.ImageDesc and $F) of
  7099. 0: tgaFormat := tfX2RGB10ui1;
  7100. 2: tgaFormat := tfA2RGB10ui1;
  7101. 8: tgaFormat := tfARGB8ui1;
  7102. end;
  7103. end;
  7104. if (tgaFormat = tfEmpty) then
  7105. raise EglBitmap.Create('LoadTga - unsupported format');
  7106. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  7107. PixelSize := FormatDesc.GetSize(1, 1);
  7108. LineSize := FormatDesc.GetSize(Header.Width, 1);
  7109. GetMem(ImageData, LineSize * Header.Height);
  7110. try
  7111. //column direction
  7112. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  7113. Counter.X.low := Header.Height-1;;
  7114. Counter.X.high := 0;
  7115. Counter.X.dir := -1;
  7116. end else begin
  7117. Counter.X.low := 0;
  7118. Counter.X.high := Header.Height-1;
  7119. Counter.X.dir := 1;
  7120. end;
  7121. // Row direction
  7122. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  7123. Counter.Y.low := 0;
  7124. Counter.Y.high := Header.Height-1;
  7125. Counter.Y.dir := 1;
  7126. end else begin
  7127. Counter.Y.low := Header.Height-1;;
  7128. Counter.Y.high := 0;
  7129. Counter.Y.dir := -1;
  7130. end;
  7131. // Read Image
  7132. case Header.ImageType of
  7133. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  7134. ReadUncompressed;
  7135. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  7136. ReadCompressed;
  7137. end;
  7138. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  7139. result := true;
  7140. except
  7141. if Assigned(ImageData) then
  7142. FreeMem(ImageData);
  7143. raise;
  7144. end;
  7145. finally
  7146. aStream.Position := StartPosition;
  7147. end;
  7148. end
  7149. else aStream.Position := StartPosition;
  7150. end;
  7151. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7152. procedure TglBitmap.SaveTGA(const aStream: TStream);
  7153. var
  7154. Header: TTGAHeader;
  7155. Size: Integer;
  7156. FormatDesc: TFormatDescriptor;
  7157. begin
  7158. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  7159. raise EglBitmapUnsupportedFormat.Create(Format);
  7160. //prepare header
  7161. FormatDesc := TFormatDescriptor.Get(Format);
  7162. FillChar(Header{%H-}, SizeOf(Header), 0);
  7163. Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
  7164. Header.Bpp := FormatDesc.BitsPerPixel;
  7165. Header.Width := Width;
  7166. Header.Height := Height;
  7167. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  7168. if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
  7169. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  7170. else
  7171. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  7172. aStream.Write(Header, SizeOf(Header));
  7173. // write Data
  7174. Size := FormatDesc.GetSize(Dimension);
  7175. aStream.Write(Data^, Size);
  7176. end;
  7177. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7178. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7179. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7180. const
  7181. DDS_MAGIC: Cardinal = $20534444;
  7182. // DDS_header.dwFlags
  7183. DDSD_CAPS = $00000001;
  7184. DDSD_HEIGHT = $00000002;
  7185. DDSD_WIDTH = $00000004;
  7186. DDSD_PIXELFORMAT = $00001000;
  7187. // DDS_header.sPixelFormat.dwFlags
  7188. DDPF_ALPHAPIXELS = $00000001;
  7189. DDPF_ALPHA = $00000002;
  7190. DDPF_FOURCC = $00000004;
  7191. DDPF_RGB = $00000040;
  7192. DDPF_LUMINANCE = $00020000;
  7193. // DDS_header.sCaps.dwCaps1
  7194. DDSCAPS_TEXTURE = $00001000;
  7195. // DDS_header.sCaps.dwCaps2
  7196. DDSCAPS2_CUBEMAP = $00000200;
  7197. D3DFMT_DXT1 = $31545844;
  7198. D3DFMT_DXT3 = $33545844;
  7199. D3DFMT_DXT5 = $35545844;
  7200. type
  7201. TDDSPixelFormat = packed record
  7202. dwSize: Cardinal;
  7203. dwFlags: Cardinal;
  7204. dwFourCC: Cardinal;
  7205. dwRGBBitCount: Cardinal;
  7206. dwRBitMask: Cardinal;
  7207. dwGBitMask: Cardinal;
  7208. dwBBitMask: Cardinal;
  7209. dwABitMask: Cardinal;
  7210. end;
  7211. TDDSCaps = packed record
  7212. dwCaps1: Cardinal;
  7213. dwCaps2: Cardinal;
  7214. dwDDSX: Cardinal;
  7215. dwReserved: Cardinal;
  7216. end;
  7217. TDDSHeader = packed record
  7218. dwSize: Cardinal;
  7219. dwFlags: Cardinal;
  7220. dwHeight: Cardinal;
  7221. dwWidth: Cardinal;
  7222. dwPitchOrLinearSize: Cardinal;
  7223. dwDepth: Cardinal;
  7224. dwMipMapCount: Cardinal;
  7225. dwReserved: array[0..10] of Cardinal;
  7226. PixelFormat: TDDSPixelFormat;
  7227. Caps: TDDSCaps;
  7228. dwReserved2: Cardinal;
  7229. end;
  7230. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7231. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  7232. var
  7233. Header: TDDSHeader;
  7234. Converter: TbmpBitfieldFormat;
  7235. function GetDDSFormat: TglBitmapFormat;
  7236. var
  7237. fd: TFormatDescriptor;
  7238. i: Integer;
  7239. Mask: TglBitmapRec4ul;
  7240. Range: TglBitmapRec4ui;
  7241. match: Boolean;
  7242. begin
  7243. result := tfEmpty;
  7244. with Header.PixelFormat do begin
  7245. // Compresses
  7246. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  7247. case Header.PixelFormat.dwFourCC of
  7248. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  7249. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  7250. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  7251. end;
  7252. end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
  7253. // prepare masks
  7254. if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
  7255. Mask.r := dwRBitMask;
  7256. Mask.g := dwGBitMask;
  7257. Mask.b := dwBBitMask;
  7258. end else begin
  7259. Mask.r := dwRBitMask;
  7260. Mask.g := dwRBitMask;
  7261. Mask.b := dwRBitMask;
  7262. end;
  7263. if (dwFlags and DDPF_ALPHAPIXELS > 0) then
  7264. Mask.a := dwABitMask
  7265. else
  7266. Mask.a := 0;;
  7267. //find matching format
  7268. fd := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
  7269. result := fd.Format;
  7270. if (result <> tfEmpty) then
  7271. exit;
  7272. //find format with same Range
  7273. for i := 0 to 3 do
  7274. Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
  7275. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  7276. fd := TFormatDescriptor.Get(result);
  7277. match := true;
  7278. for i := 0 to 3 do
  7279. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  7280. match := false;
  7281. break;
  7282. end;
  7283. if match then
  7284. break;
  7285. end;
  7286. //no format with same range found -> use default
  7287. if (result = tfEmpty) then begin
  7288. if (dwABitMask > 0) then
  7289. result := tfRGBA8ui1
  7290. else
  7291. result := tfRGB8ub3;
  7292. end;
  7293. Converter := TbmpBitfieldFormat.Create;
  7294. Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
  7295. end;
  7296. end;
  7297. end;
  7298. var
  7299. StreamPos: Int64;
  7300. x, y, LineSize, RowSize, Magic: Cardinal;
  7301. NewImage, TmpData, RowData, SrcData: System.PByte;
  7302. SourceMD, DestMD: Pointer;
  7303. Pixel: TglBitmapPixelData;
  7304. ddsFormat: TglBitmapFormat;
  7305. FormatDesc: TFormatDescriptor;
  7306. begin
  7307. result := false;
  7308. Converter := nil;
  7309. StreamPos := aStream.Position;
  7310. // Magic
  7311. aStream.Read(Magic{%H-}, sizeof(Magic));
  7312. if (Magic <> DDS_MAGIC) then begin
  7313. aStream.Position := StreamPos;
  7314. exit;
  7315. end;
  7316. //Header
  7317. aStream.Read(Header{%H-}, sizeof(Header));
  7318. if (Header.dwSize <> SizeOf(Header)) or
  7319. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  7320. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  7321. begin
  7322. aStream.Position := StreamPos;
  7323. exit;
  7324. end;
  7325. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  7326. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  7327. ddsFormat := GetDDSFormat;
  7328. try
  7329. if (ddsFormat = tfEmpty) then
  7330. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  7331. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  7332. LineSize := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
  7333. GetMem(NewImage, Header.dwHeight * LineSize);
  7334. try
  7335. TmpData := NewImage;
  7336. //Converter needed
  7337. if Assigned(Converter) then begin
  7338. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  7339. GetMem(RowData, RowSize);
  7340. SourceMD := Converter.CreateMappingData;
  7341. DestMD := FormatDesc.CreateMappingData;
  7342. try
  7343. for y := 0 to Header.dwHeight-1 do begin
  7344. TmpData := NewImage;
  7345. inc(TmpData, y * LineSize);
  7346. SrcData := RowData;
  7347. aStream.Read(SrcData^, RowSize);
  7348. for x := 0 to Header.dwWidth-1 do begin
  7349. Converter.Unmap(SrcData, Pixel, SourceMD);
  7350. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  7351. FormatDesc.Map(Pixel, TmpData, DestMD);
  7352. end;
  7353. end;
  7354. finally
  7355. Converter.FreeMappingData(SourceMD);
  7356. FormatDesc.FreeMappingData(DestMD);
  7357. FreeMem(RowData);
  7358. end;
  7359. end else
  7360. // Compressed
  7361. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  7362. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  7363. for Y := 0 to Header.dwHeight-1 do begin
  7364. aStream.Read(TmpData^, RowSize);
  7365. Inc(TmpData, LineSize);
  7366. end;
  7367. end else
  7368. // Uncompressed
  7369. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  7370. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  7371. for Y := 0 to Header.dwHeight-1 do begin
  7372. aStream.Read(TmpData^, RowSize);
  7373. Inc(TmpData, LineSize);
  7374. end;
  7375. end else
  7376. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  7377. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  7378. result := true;
  7379. except
  7380. if Assigned(NewImage) then
  7381. FreeMem(NewImage);
  7382. raise;
  7383. end;
  7384. finally
  7385. FreeAndNil(Converter);
  7386. end;
  7387. end;
  7388. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7389. procedure TglBitmap.SaveDDS(const aStream: TStream);
  7390. var
  7391. Header: TDDSHeader;
  7392. FormatDesc: TFormatDescriptor;
  7393. begin
  7394. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  7395. raise EglBitmapUnsupportedFormat.Create(Format);
  7396. FormatDesc := TFormatDescriptor.Get(Format);
  7397. // Generell
  7398. FillChar(Header{%H-}, SizeOf(Header), 0);
  7399. Header.dwSize := SizeOf(Header);
  7400. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  7401. Header.dwWidth := Max(1, Width);
  7402. Header.dwHeight := Max(1, Height);
  7403. // Caps
  7404. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  7405. // Pixelformat
  7406. Header.PixelFormat.dwSize := sizeof(Header);
  7407. if (FormatDesc.IsCompressed) then begin
  7408. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  7409. case Format of
  7410. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  7411. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  7412. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  7413. end;
  7414. end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
  7415. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  7416. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7417. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7418. end else if FormatDesc.IsGrayscale then begin
  7419. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  7420. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7421. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  7422. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7423. end else begin
  7424. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  7425. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7426. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  7427. Header.PixelFormat.dwGBitMask := FormatDesc.Mask.g;
  7428. Header.PixelFormat.dwBBitMask := FormatDesc.Mask.b;
  7429. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7430. end;
  7431. if (FormatDesc.HasAlpha) then
  7432. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  7433. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  7434. aStream.Write(Header, SizeOf(Header));
  7435. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  7436. end;
  7437. {$IFNDEF OPENGL_ES}
  7438. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7439. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7440. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7441. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7442. const aWidth: Integer; const aHeight: Integer);
  7443. var
  7444. pTemp: pByte;
  7445. Size: Integer;
  7446. begin
  7447. if (aHeight > 1) then begin
  7448. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  7449. GetMem(pTemp, Size);
  7450. try
  7451. Move(aData^, pTemp^, Size);
  7452. FreeMem(aData);
  7453. aData := nil;
  7454. except
  7455. FreeMem(pTemp);
  7456. raise;
  7457. end;
  7458. end else
  7459. pTemp := aData;
  7460. inherited SetDataPointer(pTemp, aFormat, aWidth);
  7461. end;
  7462. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7463. function TglBitmap1D.FlipHorz: Boolean;
  7464. var
  7465. Col: Integer;
  7466. pTempDest, pDest, pSource: PByte;
  7467. begin
  7468. result := inherited FlipHorz;
  7469. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  7470. pSource := Data;
  7471. GetMem(pDest, fRowSize);
  7472. try
  7473. pTempDest := pDest;
  7474. Inc(pTempDest, fRowSize);
  7475. for Col := 0 to Width-1 do begin
  7476. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  7477. Move(pSource^, pTempDest^, fPixelSize);
  7478. Inc(pSource, fPixelSize);
  7479. end;
  7480. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  7481. result := true;
  7482. except
  7483. if Assigned(pDest) then
  7484. FreeMem(pDest);
  7485. raise;
  7486. end;
  7487. end;
  7488. end;
  7489. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7490. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  7491. var
  7492. FormatDesc: TFormatDescriptor;
  7493. begin
  7494. // Upload data
  7495. FormatDesc := TFormatDescriptor.Get(Format);
  7496. if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
  7497. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7498. if FormatDesc.IsCompressed then begin
  7499. if not Assigned(glCompressedTexImage1D) then
  7500. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7501. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  7502. end else if aBuildWithGlu then
  7503. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7504. else
  7505. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7506. // Free Data
  7507. if (FreeDataAfterGenTexture) then
  7508. FreeData;
  7509. end;
  7510. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7511. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  7512. var
  7513. BuildWithGlu, TexRec: Boolean;
  7514. TexSize: Integer;
  7515. begin
  7516. if Assigned(Data) then begin
  7517. // Check Texture Size
  7518. if (aTestTextureSize) then begin
  7519. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7520. if (Width > TexSize) then
  7521. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7522. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7523. (Target = GL_TEXTURE_RECTANGLE);
  7524. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7525. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7526. end;
  7527. CreateId;
  7528. SetupParameters(BuildWithGlu);
  7529. UploadData(BuildWithGlu);
  7530. glAreTexturesResident(1, @fID, @fIsResident);
  7531. end;
  7532. end;
  7533. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7534. procedure TglBitmap1D.AfterConstruction;
  7535. begin
  7536. inherited;
  7537. Target := GL_TEXTURE_1D;
  7538. end;
  7539. {$ENDIF}
  7540. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7541. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7542. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7543. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  7544. begin
  7545. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  7546. result := fLines[aIndex]
  7547. else
  7548. result := nil;
  7549. end;
  7550. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7551. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7552. const aWidth: Integer; const aHeight: Integer);
  7553. var
  7554. Idx, LineWidth: Integer;
  7555. begin
  7556. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  7557. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  7558. // Assigning Data
  7559. if Assigned(Data) then begin
  7560. SetLength(fLines, GetHeight);
  7561. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel);
  7562. for Idx := 0 to GetHeight-1 do begin
  7563. fLines[Idx] := Data;
  7564. Inc(fLines[Idx], Idx * LineWidth);
  7565. end;
  7566. end
  7567. else SetLength(fLines, 0);
  7568. end else begin
  7569. SetLength(fLines, 0);
  7570. end;
  7571. end;
  7572. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7573. procedure TglBitmap2D.UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
  7574. var
  7575. FormatDesc: TFormatDescriptor;
  7576. begin
  7577. FormatDesc := TFormatDescriptor.Get(Format);
  7578. if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
  7579. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7580. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7581. if FormatDesc.IsCompressed then begin
  7582. if not Assigned(glCompressedTexImage2D) then
  7583. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7584. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  7585. {$IFNDEF OPENGL_ES}
  7586. end else if aBuildWithGlu then begin
  7587. gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height,
  7588. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7589. {$ENDIF}
  7590. end else begin
  7591. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  7592. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7593. end;
  7594. // Freigeben
  7595. if (FreeDataAfterGenTexture) then
  7596. FreeData;
  7597. end;
  7598. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7599. procedure TglBitmap2D.AfterConstruction;
  7600. begin
  7601. inherited;
  7602. Target := GL_TEXTURE_2D;
  7603. end;
  7604. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7605. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  7606. var
  7607. Temp: pByte;
  7608. Size, w, h: Integer;
  7609. FormatDesc: TFormatDescriptor;
  7610. begin
  7611. FormatDesc := TFormatDescriptor.Get(aFormat);
  7612. if FormatDesc.IsCompressed then
  7613. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7614. w := aRight - aLeft;
  7615. h := aBottom - aTop;
  7616. Size := FormatDesc.GetSize(w, h);
  7617. GetMem(Temp, Size);
  7618. try
  7619. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7620. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7621. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  7622. FlipVert;
  7623. except
  7624. if Assigned(Temp) then
  7625. FreeMem(Temp);
  7626. raise;
  7627. end;
  7628. end;
  7629. {$IFNDEF OPENGL_ES}
  7630. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7631. procedure TglBitmap2D.GetDataFromTexture;
  7632. var
  7633. Temp: PByte;
  7634. TempWidth, TempHeight: Integer;
  7635. TempIntFormat: GLint;
  7636. IntFormat: TglBitmapFormat;
  7637. FormatDesc: TFormatDescriptor;
  7638. begin
  7639. Bind;
  7640. // Request Data
  7641. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7642. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7643. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7644. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7645. IntFormat := FormatDesc.Format;
  7646. // Getting data from OpenGL
  7647. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7648. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7649. try
  7650. if FormatDesc.IsCompressed then begin
  7651. if not Assigned(glGetCompressedTexImage) then
  7652. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7653. glGetCompressedTexImage(Target, 0, Temp)
  7654. end else
  7655. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7656. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7657. except
  7658. if Assigned(Temp) then
  7659. FreeMem(Temp);
  7660. raise;
  7661. end;
  7662. end;
  7663. {$ENDIF}
  7664. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7665. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7666. var
  7667. {$IFNDEF OPENGL_ES}
  7668. BuildWithGlu, TexRec: Boolean;
  7669. {$ENDIF}
  7670. PotTex: Boolean;
  7671. TexSize: Integer;
  7672. begin
  7673. if Assigned(Data) then begin
  7674. // Check Texture Size
  7675. if (aTestTextureSize) then begin
  7676. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7677. if ((Height > TexSize) or (Width > TexSize)) then
  7678. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7679. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7680. {$IF NOT DEFINED(OPENGL_ES)}
  7681. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7682. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7683. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7684. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7685. if not PotTex and not GL_OES_texture_npot then
  7686. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7687. {$ELSE}
  7688. if not PotTex then
  7689. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7690. {$IFEND}
  7691. end;
  7692. CreateId;
  7693. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7694. UploadData(Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7695. {$IFNDEF OPENGL_ES}
  7696. glAreTexturesResident(1, @fID, @fIsResident);
  7697. {$ENDIF}
  7698. end;
  7699. end;
  7700. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7701. function TglBitmap2D.FlipHorz: Boolean;
  7702. var
  7703. Col, Row: Integer;
  7704. TempDestData, DestData, SourceData: PByte;
  7705. ImgSize: Integer;
  7706. begin
  7707. result := inherited FlipHorz;
  7708. if Assigned(Data) then begin
  7709. SourceData := Data;
  7710. ImgSize := Height * fRowSize;
  7711. GetMem(DestData, ImgSize);
  7712. try
  7713. TempDestData := DestData;
  7714. Dec(TempDestData, fRowSize + fPixelSize);
  7715. for Row := 0 to Height -1 do begin
  7716. Inc(TempDestData, fRowSize * 2);
  7717. for Col := 0 to Width -1 do begin
  7718. Move(SourceData^, TempDestData^, fPixelSize);
  7719. Inc(SourceData, fPixelSize);
  7720. Dec(TempDestData, fPixelSize);
  7721. end;
  7722. end;
  7723. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7724. result := true;
  7725. except
  7726. if Assigned(DestData) then
  7727. FreeMem(DestData);
  7728. raise;
  7729. end;
  7730. end;
  7731. end;
  7732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7733. function TglBitmap2D.FlipVert: Boolean;
  7734. var
  7735. Row: Integer;
  7736. TempDestData, DestData, SourceData: PByte;
  7737. begin
  7738. result := inherited FlipVert;
  7739. if Assigned(Data) then begin
  7740. SourceData := Data;
  7741. GetMem(DestData, Height * fRowSize);
  7742. try
  7743. TempDestData := DestData;
  7744. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7745. for Row := 0 to Height -1 do begin
  7746. Move(SourceData^, TempDestData^, fRowSize);
  7747. Dec(TempDestData, fRowSize);
  7748. Inc(SourceData, fRowSize);
  7749. end;
  7750. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7751. result := true;
  7752. except
  7753. if Assigned(DestData) then
  7754. FreeMem(DestData);
  7755. raise;
  7756. end;
  7757. end;
  7758. end;
  7759. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7760. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7761. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7762. type
  7763. TMatrixItem = record
  7764. X, Y: Integer;
  7765. W: Single;
  7766. end;
  7767. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7768. TglBitmapToNormalMapRec = Record
  7769. Scale: Single;
  7770. Heights: array of Single;
  7771. MatrixU : array of TMatrixItem;
  7772. MatrixV : array of TMatrixItem;
  7773. end;
  7774. const
  7775. ONE_OVER_255 = 1 / 255;
  7776. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7777. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7778. var
  7779. Val: Single;
  7780. begin
  7781. with FuncRec do begin
  7782. Val :=
  7783. Source.Data.r * LUMINANCE_WEIGHT_R +
  7784. Source.Data.g * LUMINANCE_WEIGHT_G +
  7785. Source.Data.b * LUMINANCE_WEIGHT_B;
  7786. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7787. end;
  7788. end;
  7789. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7790. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7791. begin
  7792. with FuncRec do
  7793. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7794. end;
  7795. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7796. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7797. type
  7798. TVec = Array[0..2] of Single;
  7799. var
  7800. Idx: Integer;
  7801. du, dv: Double;
  7802. Len: Single;
  7803. Vec: TVec;
  7804. function GetHeight(X, Y: Integer): Single;
  7805. begin
  7806. with FuncRec do begin
  7807. X := Max(0, Min(Size.X -1, X));
  7808. Y := Max(0, Min(Size.Y -1, Y));
  7809. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7810. end;
  7811. end;
  7812. begin
  7813. with FuncRec do begin
  7814. with PglBitmapToNormalMapRec(Args)^ do begin
  7815. du := 0;
  7816. for Idx := Low(MatrixU) to High(MatrixU) do
  7817. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7818. dv := 0;
  7819. for Idx := Low(MatrixU) to High(MatrixU) do
  7820. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7821. Vec[0] := -du * Scale;
  7822. Vec[1] := -dv * Scale;
  7823. Vec[2] := 1;
  7824. end;
  7825. // Normalize
  7826. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7827. if Len <> 0 then begin
  7828. Vec[0] := Vec[0] * Len;
  7829. Vec[1] := Vec[1] * Len;
  7830. Vec[2] := Vec[2] * Len;
  7831. end;
  7832. // Farbe zuweisem
  7833. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7834. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7835. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7836. end;
  7837. end;
  7838. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7839. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7840. var
  7841. Rec: TglBitmapToNormalMapRec;
  7842. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7843. begin
  7844. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7845. Matrix[Index].X := X;
  7846. Matrix[Index].Y := Y;
  7847. Matrix[Index].W := W;
  7848. end;
  7849. end;
  7850. begin
  7851. if TFormatDescriptor.Get(Format).IsCompressed then
  7852. raise EglBitmapUnsupportedFormat.Create(Format);
  7853. if aScale > 100 then
  7854. Rec.Scale := 100
  7855. else if aScale < -100 then
  7856. Rec.Scale := -100
  7857. else
  7858. Rec.Scale := aScale;
  7859. SetLength(Rec.Heights, Width * Height);
  7860. try
  7861. case aFunc of
  7862. nm4Samples: begin
  7863. SetLength(Rec.MatrixU, 2);
  7864. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7865. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7866. SetLength(Rec.MatrixV, 2);
  7867. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7868. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7869. end;
  7870. nmSobel: begin
  7871. SetLength(Rec.MatrixU, 6);
  7872. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7873. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7874. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7875. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7876. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7877. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7878. SetLength(Rec.MatrixV, 6);
  7879. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7880. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7881. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7882. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7883. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7884. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7885. end;
  7886. nm3x3: begin
  7887. SetLength(Rec.MatrixU, 6);
  7888. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7889. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7890. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7891. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7892. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7893. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7894. SetLength(Rec.MatrixV, 6);
  7895. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7896. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7897. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7898. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7899. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7900. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7901. end;
  7902. nm5x5: begin
  7903. SetLength(Rec.MatrixU, 20);
  7904. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7905. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7906. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7907. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7908. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7909. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7910. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7911. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7912. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7913. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7914. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7915. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7916. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7917. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7918. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7919. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7920. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7921. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7922. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7923. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7924. SetLength(Rec.MatrixV, 20);
  7925. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7926. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7927. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7928. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7929. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7930. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7931. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7932. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7933. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7934. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7935. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7936. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7937. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7938. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7939. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7940. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7941. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7942. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7943. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7944. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7945. end;
  7946. end;
  7947. // Daten Sammeln
  7948. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7949. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7950. else
  7951. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7952. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7953. finally
  7954. SetLength(Rec.Heights, 0);
  7955. end;
  7956. end;
  7957. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7958. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7959. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7960. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7961. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7962. begin
  7963. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7964. end;
  7965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7966. procedure TglBitmapCubeMap.AfterConstruction;
  7967. begin
  7968. inherited;
  7969. {$IFNDEF OPENGL_ES}
  7970. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7971. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7972. {$ELSE}
  7973. if not (GL_VERSION_2_0) then
  7974. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7975. {$ENDIF}
  7976. SetWrap;
  7977. Target := GL_TEXTURE_CUBE_MAP;
  7978. {$IFNDEF OPENGL_ES}
  7979. fGenMode := GL_REFLECTION_MAP;
  7980. {$ENDIF}
  7981. end;
  7982. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7983. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7984. var
  7985. {$IFNDEF OPENGL_ES}
  7986. BuildWithGlu: Boolean;
  7987. {$ENDIF}
  7988. TexSize: Integer;
  7989. begin
  7990. if (aTestTextureSize) then begin
  7991. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7992. if (Height > TexSize) or (Width > TexSize) then
  7993. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7994. {$IF NOT DEFINED(OPENGL_ES)}
  7995. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7996. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7997. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7998. if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) and not GL_OES_texture_npot then
  7999. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  8000. {$ELSE}
  8001. if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) then
  8002. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  8003. {$IFEND}
  8004. end;
  8005. if (ID = 0) then
  8006. CreateID;
  8007. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  8008. UploadData(aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  8009. end;
  8010. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8011. procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
  8012. begin
  8013. inherited Bind (aEnableTextureUnit);
  8014. {$IFNDEF OPENGL_ES}
  8015. if aEnableTexCoordsGen then begin
  8016. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  8017. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  8018. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  8019. glEnable(GL_TEXTURE_GEN_S);
  8020. glEnable(GL_TEXTURE_GEN_T);
  8021. glEnable(GL_TEXTURE_GEN_R);
  8022. end;
  8023. {$ENDIF}
  8024. end;
  8025. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8026. procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
  8027. begin
  8028. inherited Unbind(aDisableTextureUnit);
  8029. {$IFNDEF OPENGL_ES}
  8030. if aDisableTexCoordsGen then begin
  8031. glDisable(GL_TEXTURE_GEN_S);
  8032. glDisable(GL_TEXTURE_GEN_T);
  8033. glDisable(GL_TEXTURE_GEN_R);
  8034. end;
  8035. {$ENDIF}
  8036. end;
  8037. {$IFEND}
  8038. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  8039. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8040. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8041. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8042. type
  8043. TVec = Array[0..2] of Single;
  8044. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8045. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  8046. TglBitmapNormalMapRec = record
  8047. HalfSize : Integer;
  8048. Func: TglBitmapNormalMapGetVectorFunc;
  8049. end;
  8050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8051. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8052. begin
  8053. aVec[0] := aHalfSize;
  8054. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  8055. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  8056. end;
  8057. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8058. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8059. begin
  8060. aVec[0] := - aHalfSize;
  8061. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  8062. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  8063. end;
  8064. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8065. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8066. begin
  8067. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  8068. aVec[1] := aHalfSize;
  8069. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  8070. end;
  8071. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8072. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8073. begin
  8074. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  8075. aVec[1] := - aHalfSize;
  8076. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  8077. end;
  8078. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8079. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8080. begin
  8081. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  8082. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  8083. aVec[2] := aHalfSize;
  8084. end;
  8085. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8086. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8087. begin
  8088. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  8089. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  8090. aVec[2] := - aHalfSize;
  8091. end;
  8092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8093. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  8094. var
  8095. i: Integer;
  8096. Vec: TVec;
  8097. Len: Single;
  8098. begin
  8099. with FuncRec do begin
  8100. with PglBitmapNormalMapRec(Args)^ do begin
  8101. Func(Vec, Position, HalfSize);
  8102. // Normalize
  8103. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  8104. if Len <> 0 then begin
  8105. Vec[0] := Vec[0] * Len;
  8106. Vec[1] := Vec[1] * Len;
  8107. Vec[2] := Vec[2] * Len;
  8108. end;
  8109. // Scale Vector and AddVectro
  8110. Vec[0] := Vec[0] * 0.5 + 0.5;
  8111. Vec[1] := Vec[1] * 0.5 + 0.5;
  8112. Vec[2] := Vec[2] * 0.5 + 0.5;
  8113. end;
  8114. // Set Color
  8115. for i := 0 to 2 do
  8116. Dest.Data.arr[i] := Round(Vec[i] * 255);
  8117. end;
  8118. end;
  8119. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8120. procedure TglBitmapNormalMap.AfterConstruction;
  8121. begin
  8122. inherited;
  8123. {$IFNDEF OPENGL_ES}
  8124. fGenMode := GL_NORMAL_MAP;
  8125. {$ENDIF}
  8126. end;
  8127. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8128. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  8129. var
  8130. Rec: TglBitmapNormalMapRec;
  8131. SizeRec: TglBitmapPixelPosition;
  8132. begin
  8133. Rec.HalfSize := aSize div 2;
  8134. FreeDataAfterGenTexture := false;
  8135. SizeRec.Fields := [ffX, ffY];
  8136. SizeRec.X := aSize;
  8137. SizeRec.Y := aSize;
  8138. // Positive X
  8139. Rec.Func := glBitmapNormalMapPosX;
  8140. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8141. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  8142. // Negative X
  8143. Rec.Func := glBitmapNormalMapNegX;
  8144. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8145. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  8146. // Positive Y
  8147. Rec.Func := glBitmapNormalMapPosY;
  8148. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8149. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  8150. // Negative Y
  8151. Rec.Func := glBitmapNormalMapNegY;
  8152. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8153. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  8154. // Positive Z
  8155. Rec.Func := glBitmapNormalMapPosZ;
  8156. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8157. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  8158. // Negative Z
  8159. Rec.Func := glBitmapNormalMapNegZ;
  8160. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8161. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  8162. end;
  8163. {$IFEND}
  8164. initialization
  8165. glBitmapSetDefaultFormat (tfEmpty);
  8166. glBitmapSetDefaultMipmap (mmMipmap);
  8167. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  8168. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  8169. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  8170. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  8171. {$IFEND}
  8172. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  8173. glBitmapSetDefaultDeleteTextureOnFree (true);
  8174. TFormatDescriptor.Init;
  8175. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  8176. OpenGLInitialized := false;
  8177. InitOpenGLCS := TCriticalSection.Create;
  8178. {$ENDIF}
  8179. finalization
  8180. TFormatDescriptor.Finalize;
  8181. {$IFDEF GLB_NATIVE_OGL}
  8182. if Assigned(GL_LibHandle) then
  8183. glbFreeLibrary(GL_LibHandle);
  8184. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  8185. if Assigned(GLU_LibHandle) then
  8186. glbFreeLibrary(GLU_LibHandle);
  8187. FreeAndNil(InitOpenGLCS);
  8188. {$ENDIF}
  8189. {$ENDIF}
  8190. end.