Ви не можете вибрати більше 25 тем Теми мають розпочинатися з літери або цифри, можуть містити дефіси (-) і не повинні перевищувати 35 символів.

9282 рядки
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 uglcBitmap;
  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. TglcBitmapFormat = TglBitmapFormat;
  1125. TglcBitmap1D = TglBitmap1D;
  1126. TglcBitmap2D = TglBitmap2D;
  1127. TglcBitmapCubeMap = TglBitmapCubeMap;
  1128. TglcBitmapNormalMap = TglBitmapNormalMap;
  1129. const
  1130. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1131. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1132. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1133. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1134. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1135. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1136. procedure glBitmapSetDefaultWrap(
  1137. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1138. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1139. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1140. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1141. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1142. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1143. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1144. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1145. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1146. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1147. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1148. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1149. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1150. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1151. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1152. function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
  1153. var
  1154. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1155. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1156. glBitmapDefaultFormat: TglBitmapFormat;
  1157. glBitmapDefaultMipmap: TglBitmapMipMap;
  1158. glBitmapDefaultFilterMin: Cardinal;
  1159. glBitmapDefaultFilterMag: Cardinal;
  1160. glBitmapDefaultWrapS: Cardinal;
  1161. glBitmapDefaultWrapT: Cardinal;
  1162. glBitmapDefaultWrapR: Cardinal;
  1163. glDefaultSwizzle: array[0..3] of GLenum;
  1164. {$IFDEF GLB_DELPHI}
  1165. function CreateGrayPalette: HPALETTE;
  1166. {$ENDIF}
  1167. implementation
  1168. uses
  1169. Math, syncobjs, typinfo
  1170. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1171. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1172. type
  1173. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1174. public
  1175. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1176. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1177. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1178. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1179. function CreateMappingData: Pointer; virtual;
  1180. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1181. function IsEmpty: Boolean; virtual;
  1182. function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
  1183. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1184. constructor Create; virtual;
  1185. public
  1186. class procedure Init;
  1187. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1188. class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1189. class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
  1190. class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  1191. class procedure Clear;
  1192. class procedure Finalize;
  1193. end;
  1194. TFormatDescriptorClass = class of TFormatDescriptor;
  1195. TfdEmpty = class(TFormatDescriptor);
  1196. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1197. TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
  1198. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1199. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1200. end;
  1201. TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
  1202. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1203. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1204. end;
  1205. TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
  1206. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1207. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1208. end;
  1209. TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
  1210. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1211. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1212. end;
  1213. TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
  1214. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1215. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1216. end;
  1217. TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1218. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1219. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1220. end;
  1221. TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
  1222. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1223. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1224. end;
  1225. TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
  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. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1230. TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
  1231. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1232. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1233. end;
  1234. TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
  1235. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1236. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1237. end;
  1238. TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
  1239. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1240. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1241. end;
  1242. TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
  1243. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1244. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1245. end;
  1246. TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
  1247. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1248. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1249. end;
  1250. TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
  1251. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1252. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1253. end;
  1254. TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1255. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1256. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1257. end;
  1258. TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
  1259. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1260. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1261. end;
  1262. TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
  1263. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1264. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1265. end;
  1266. TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1267. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1268. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1269. end;
  1270. TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  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. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1275. TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
  1276. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1277. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1278. end;
  1279. TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
  1280. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1281. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1282. end;
  1283. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1284. TfdAlpha4ub1 = class(TfdAlphaUB1)
  1285. procedure SetValues; override;
  1286. end;
  1287. TfdAlpha8ub1 = class(TfdAlphaUB1)
  1288. procedure SetValues; override;
  1289. end;
  1290. TfdAlpha16us1 = class(TfdAlphaUS1)
  1291. procedure SetValues; override;
  1292. end;
  1293. TfdLuminance4ub1 = class(TfdLuminanceUB1)
  1294. procedure SetValues; override;
  1295. end;
  1296. TfdLuminance8ub1 = class(TfdLuminanceUB1)
  1297. procedure SetValues; override;
  1298. end;
  1299. TfdLuminance16us1 = class(TfdLuminanceUS1)
  1300. procedure SetValues; override;
  1301. end;
  1302. TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
  1303. procedure SetValues; override;
  1304. end;
  1305. TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
  1306. procedure SetValues; override;
  1307. end;
  1308. TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
  1309. procedure SetValues; override;
  1310. end;
  1311. TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
  1312. procedure SetValues; override;
  1313. end;
  1314. TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
  1315. procedure SetValues; override;
  1316. end;
  1317. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1318. TfdR3G3B2ub1 = class(TfdUniversalUB1)
  1319. procedure SetValues; override;
  1320. end;
  1321. TfdRGBX4us1 = class(TfdUniversalUS1)
  1322. procedure SetValues; override;
  1323. end;
  1324. TfdXRGB4us1 = class(TfdUniversalUS1)
  1325. procedure SetValues; override;
  1326. end;
  1327. TfdR5G6B5us1 = class(TfdUniversalUS1)
  1328. procedure SetValues; override;
  1329. end;
  1330. TfdRGB5X1us1 = class(TfdUniversalUS1)
  1331. procedure SetValues; override;
  1332. end;
  1333. TfdX1RGB5us1 = class(TfdUniversalUS1)
  1334. procedure SetValues; override;
  1335. end;
  1336. TfdRGB8ub3 = class(TfdRGBub3)
  1337. procedure SetValues; override;
  1338. end;
  1339. TfdRGBX8ui1 = class(TfdUniversalUI1)
  1340. procedure SetValues; override;
  1341. end;
  1342. TfdXRGB8ui1 = class(TfdUniversalUI1)
  1343. procedure SetValues; override;
  1344. end;
  1345. TfdRGB10X2ui1 = class(TfdUniversalUI1)
  1346. procedure SetValues; override;
  1347. end;
  1348. TfdX2RGB10ui1 = class(TfdUniversalUI1)
  1349. procedure SetValues; override;
  1350. end;
  1351. TfdRGB16us3 = class(TfdRGBus3)
  1352. procedure SetValues; override;
  1353. end;
  1354. TfdRGBA4us1 = class(TfdUniversalUS1)
  1355. procedure SetValues; override;
  1356. end;
  1357. TfdARGB4us1 = class(TfdUniversalUS1)
  1358. procedure SetValues; override;
  1359. end;
  1360. TfdRGB5A1us1 = class(TfdUniversalUS1)
  1361. procedure SetValues; override;
  1362. end;
  1363. TfdA1RGB5us1 = class(TfdUniversalUS1)
  1364. procedure SetValues; override;
  1365. end;
  1366. TfdRGBA8ui1 = class(TfdUniversalUI1)
  1367. procedure SetValues; override;
  1368. end;
  1369. TfdARGB8ui1 = class(TfdUniversalUI1)
  1370. procedure SetValues; override;
  1371. end;
  1372. TfdRGBA8ub4 = class(TfdRGBAub4)
  1373. procedure SetValues; override;
  1374. end;
  1375. TfdRGB10A2ui1 = class(TfdUniversalUI1)
  1376. procedure SetValues; override;
  1377. end;
  1378. TfdA2RGB10ui1 = class(TfdUniversalUI1)
  1379. procedure SetValues; override;
  1380. end;
  1381. TfdRGBA16us4 = class(TfdRGBAus4)
  1382. procedure SetValues; override;
  1383. end;
  1384. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1385. TfdBGRX4us1 = class(TfdUniversalUS1)
  1386. procedure SetValues; override;
  1387. end;
  1388. TfdXBGR4us1 = class(TfdUniversalUS1)
  1389. procedure SetValues; override;
  1390. end;
  1391. TfdB5G6R5us1 = class(TfdUniversalUS1)
  1392. procedure SetValues; override;
  1393. end;
  1394. TfdBGR5X1us1 = class(TfdUniversalUS1)
  1395. procedure SetValues; override;
  1396. end;
  1397. TfdX1BGR5us1 = class(TfdUniversalUS1)
  1398. procedure SetValues; override;
  1399. end;
  1400. TfdBGR8ub3 = class(TfdBGRub3)
  1401. procedure SetValues; override;
  1402. end;
  1403. TfdBGRX8ui1 = class(TfdUniversalUI1)
  1404. procedure SetValues; override;
  1405. end;
  1406. TfdXBGR8ui1 = class(TfdUniversalUI1)
  1407. procedure SetValues; override;
  1408. end;
  1409. TfdBGR10X2ui1 = class(TfdUniversalUI1)
  1410. procedure SetValues; override;
  1411. end;
  1412. TfdX2BGR10ui1 = class(TfdUniversalUI1)
  1413. procedure SetValues; override;
  1414. end;
  1415. TfdBGR16us3 = class(TfdBGRus3)
  1416. procedure SetValues; override;
  1417. end;
  1418. TfdBGRA4us1 = class(TfdUniversalUS1)
  1419. procedure SetValues; override;
  1420. end;
  1421. TfdABGR4us1 = class(TfdUniversalUS1)
  1422. procedure SetValues; override;
  1423. end;
  1424. TfdBGR5A1us1 = class(TfdUniversalUS1)
  1425. procedure SetValues; override;
  1426. end;
  1427. TfdA1BGR5us1 = class(TfdUniversalUS1)
  1428. procedure SetValues; override;
  1429. end;
  1430. TfdBGRA8ui1 = class(TfdUniversalUI1)
  1431. procedure SetValues; override;
  1432. end;
  1433. TfdABGR8ui1 = class(TfdUniversalUI1)
  1434. procedure SetValues; override;
  1435. end;
  1436. TfdBGRA8ub4 = class(TfdBGRAub4)
  1437. procedure SetValues; override;
  1438. end;
  1439. TfdBGR10A2ui1 = class(TfdUniversalUI1)
  1440. procedure SetValues; override;
  1441. end;
  1442. TfdA2BGR10ui1 = class(TfdUniversalUI1)
  1443. procedure SetValues; override;
  1444. end;
  1445. TfdBGRA16us4 = class(TfdBGRAus4)
  1446. procedure SetValues; override;
  1447. end;
  1448. TfdDepth16us1 = class(TfdDepthUS1)
  1449. procedure SetValues; override;
  1450. end;
  1451. TfdDepth24ui1 = class(TfdDepthUI1)
  1452. procedure SetValues; override;
  1453. end;
  1454. TfdDepth32ui1 = class(TfdDepthUI1)
  1455. procedure SetValues; override;
  1456. end;
  1457. TfdS3tcDtx1RGBA = 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. TfdS3tcDtx3RGBA = 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. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1468. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1469. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1470. procedure SetValues; override;
  1471. end;
  1472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1473. TbmpBitfieldFormat = class(TFormatDescriptor)
  1474. public
  1475. procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
  1476. procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1477. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1478. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1479. end;
  1480. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1481. TbmpColorTableEnty = packed record
  1482. b, g, r, a: Byte;
  1483. end;
  1484. TbmpColorTable = array of TbmpColorTableEnty;
  1485. TbmpColorTableFormat = class(TFormatDescriptor)
  1486. private
  1487. fBitsPerPixel: Integer;
  1488. fColorTable: TbmpColorTable;
  1489. protected
  1490. procedure SetValues; override;
  1491. public
  1492. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1493. property BitsPerPixel: Integer read fBitsPerPixel write fBitsPerPixel;
  1494. procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1495. procedure CalcValues;
  1496. procedure CreateColorTable;
  1497. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1498. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1499. destructor Destroy; override;
  1500. end;
  1501. const
  1502. LUMINANCE_WEIGHT_R = 0.30;
  1503. LUMINANCE_WEIGHT_G = 0.59;
  1504. LUMINANCE_WEIGHT_B = 0.11;
  1505. ALPHA_WEIGHT_R = 0.30;
  1506. ALPHA_WEIGHT_G = 0.59;
  1507. ALPHA_WEIGHT_B = 0.11;
  1508. DEPTH_WEIGHT_R = 0.333333333;
  1509. DEPTH_WEIGHT_G = 0.333333333;
  1510. DEPTH_WEIGHT_B = 0.333333333;
  1511. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1512. TfdEmpty,
  1513. TfdAlpha4ub1,
  1514. TfdAlpha8ub1,
  1515. TfdAlpha16us1,
  1516. TfdLuminance4ub1,
  1517. TfdLuminance8ub1,
  1518. TfdLuminance16us1,
  1519. TfdLuminance4Alpha4ub2,
  1520. TfdLuminance6Alpha2ub2,
  1521. TfdLuminance8Alpha8ub2,
  1522. TfdLuminance12Alpha4us2,
  1523. TfdLuminance16Alpha16us2,
  1524. TfdR3G3B2ub1,
  1525. TfdRGBX4us1,
  1526. TfdXRGB4us1,
  1527. TfdR5G6B5us1,
  1528. TfdRGB5X1us1,
  1529. TfdX1RGB5us1,
  1530. TfdRGB8ub3,
  1531. TfdRGBX8ui1,
  1532. TfdXRGB8ui1,
  1533. TfdRGB10X2ui1,
  1534. TfdX2RGB10ui1,
  1535. TfdRGB16us3,
  1536. TfdRGBA4us1,
  1537. TfdARGB4us1,
  1538. TfdRGB5A1us1,
  1539. TfdA1RGB5us1,
  1540. TfdRGBA8ui1,
  1541. TfdARGB8ui1,
  1542. TfdRGBA8ub4,
  1543. TfdRGB10A2ui1,
  1544. TfdA2RGB10ui1,
  1545. TfdRGBA16us4,
  1546. TfdBGRX4us1,
  1547. TfdXBGR4us1,
  1548. TfdB5G6R5us1,
  1549. TfdBGR5X1us1,
  1550. TfdX1BGR5us1,
  1551. TfdBGR8ub3,
  1552. TfdBGRX8ui1,
  1553. TfdXBGR8ui1,
  1554. TfdBGR10X2ui1,
  1555. TfdX2BGR10ui1,
  1556. TfdBGR16us3,
  1557. TfdBGRA4us1,
  1558. TfdABGR4us1,
  1559. TfdBGR5A1us1,
  1560. TfdA1BGR5us1,
  1561. TfdBGRA8ui1,
  1562. TfdABGR8ui1,
  1563. TfdBGRA8ub4,
  1564. TfdBGR10A2ui1,
  1565. TfdA2BGR10ui1,
  1566. TfdBGRA16us4,
  1567. TfdDepth16us1,
  1568. TfdDepth24ui1,
  1569. TfdDepth32ui1,
  1570. TfdS3tcDtx1RGBA,
  1571. TfdS3tcDtx3RGBA,
  1572. TfdS3tcDtx5RGBA
  1573. );
  1574. var
  1575. FormatDescriptorCS: TCriticalSection;
  1576. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1577. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1578. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1579. begin
  1580. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1581. end;
  1582. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1583. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1584. begin
  1585. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1586. end;
  1587. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1588. function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
  1589. begin
  1590. result.Fields := [];
  1591. if X >= 0 then
  1592. result.Fields := result.Fields + [ffX];
  1593. if Y >= 0 then
  1594. result.Fields := result.Fields + [ffY];
  1595. result.X := Max(0, X);
  1596. result.Y := Max(0, Y);
  1597. end;
  1598. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1599. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1600. begin
  1601. result.r := r;
  1602. result.g := g;
  1603. result.b := b;
  1604. result.a := a;
  1605. end;
  1606. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1607. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1608. begin
  1609. result.r := r;
  1610. result.g := g;
  1611. result.b := b;
  1612. result.a := a;
  1613. end;
  1614. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1615. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1616. begin
  1617. result.r := r;
  1618. result.g := g;
  1619. result.b := b;
  1620. result.a := a;
  1621. end;
  1622. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1623. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1624. var
  1625. i: Integer;
  1626. begin
  1627. result := false;
  1628. for i := 0 to high(r1.arr) do
  1629. if (r1.arr[i] <> r2.arr[i]) then
  1630. exit;
  1631. result := true;
  1632. end;
  1633. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1634. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1635. var
  1636. i: Integer;
  1637. begin
  1638. result := false;
  1639. for i := 0 to high(r1.arr) do
  1640. if (r1.arr[i] <> r2.arr[i]) then
  1641. exit;
  1642. result := true;
  1643. end;
  1644. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1645. function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
  1646. var
  1647. desc: TFormatDescriptor;
  1648. p, tmp: PByte;
  1649. x, y, i: Integer;
  1650. md: Pointer;
  1651. px: TglBitmapPixelData;
  1652. begin
  1653. result := nil;
  1654. desc := TFormatDescriptor.Get(aFormat);
  1655. if (desc.IsCompressed) or (desc.glFormat = 0) then
  1656. exit;
  1657. p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
  1658. md := desc.CreateMappingData;
  1659. try
  1660. tmp := p;
  1661. desc.PreparePixel(px);
  1662. for y := 0 to 4 do
  1663. for x := 0 to 4 do begin
  1664. px.Data := glBitmapRec4ui(0, 0, 0, 0);
  1665. for i := 0 to 3 do begin
  1666. if ((y < 3) and (y = i)) or
  1667. ((y = 3) and (i < 3)) or
  1668. ((y = 4) and (i = 3))
  1669. then
  1670. px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
  1671. else if ((y < 4) and (i = 3)) or
  1672. ((y = 4) and (i < 3))
  1673. then
  1674. px.Data.arr[i] := px.Range.arr[i]
  1675. else
  1676. px.Data.arr[i] := 0; //px.Range.arr[i];
  1677. end;
  1678. desc.Map(px, tmp, md);
  1679. end;
  1680. finally
  1681. desc.FreeMappingData(md);
  1682. end;
  1683. result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
  1684. result.FreeDataOnDestroy := true;
  1685. result.FreeDataAfterGenTexture := false;
  1686. result.SetFilter(GL_NEAREST, GL_NEAREST);
  1687. end;
  1688. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1689. function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
  1690. begin
  1691. result.r := r;
  1692. result.g := g;
  1693. result.b := b;
  1694. result.a := a;
  1695. end;
  1696. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1697. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1698. begin
  1699. result := [];
  1700. if (aFormat in [
  1701. //8bpp
  1702. tfAlpha4ub1, tfAlpha8ub1,
  1703. tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
  1704. //16bpp
  1705. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1706. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  1707. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
  1708. //24bpp
  1709. tfBGR8ub3, tfRGB8ub3,
  1710. //32bpp
  1711. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  1712. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
  1713. then
  1714. result := result + [ ftBMP ];
  1715. if (aFormat in [
  1716. //8bbp
  1717. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
  1718. //16bbp
  1719. tfAlpha16us1, tfLuminance16us1,
  1720. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1721. tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
  1722. //24bbp
  1723. tfBGR8ub3,
  1724. //32bbp
  1725. tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
  1726. tfDepth24ui1, tfDepth32ui1])
  1727. then
  1728. result := result + [ftTGA];
  1729. if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
  1730. result := result + [ftDDS];
  1731. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1732. if aFormat in [
  1733. tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
  1734. tfRGB8ub3, tfRGBA8ui1,
  1735. tfBGR8ub3, tfBGRA8ui1] then
  1736. result := result + [ftPNG];
  1737. {$ENDIF}
  1738. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1739. if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
  1740. result := result + [ftJPEG];
  1741. {$ENDIF}
  1742. end;
  1743. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1744. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1745. begin
  1746. while (aNumber and 1) = 0 do
  1747. aNumber := aNumber shr 1;
  1748. result := aNumber = 1;
  1749. end;
  1750. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1751. function GetTopMostBit(aBitSet: QWord): Integer;
  1752. begin
  1753. result := 0;
  1754. while aBitSet > 0 do begin
  1755. inc(result);
  1756. aBitSet := aBitSet shr 1;
  1757. end;
  1758. end;
  1759. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1760. function CountSetBits(aBitSet: QWord): Integer;
  1761. begin
  1762. result := 0;
  1763. while aBitSet > 0 do begin
  1764. if (aBitSet and 1) = 1 then
  1765. inc(result);
  1766. aBitSet := aBitSet shr 1;
  1767. end;
  1768. end;
  1769. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1770. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1771. begin
  1772. result := Trunc(
  1773. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1774. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1775. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1776. end;
  1777. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1778. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1779. begin
  1780. result := Trunc(
  1781. DEPTH_WEIGHT_R * aPixel.Data.r +
  1782. DEPTH_WEIGHT_G * aPixel.Data.g +
  1783. DEPTH_WEIGHT_B * aPixel.Data.b);
  1784. end;
  1785. {$IFDEF GLB_NATIVE_OGL}
  1786. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1787. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1788. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1789. var
  1790. GL_LibHandle: Pointer = nil;
  1791. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
  1792. begin
  1793. if not Assigned(aLibHandle) then
  1794. aLibHandle := GL_LibHandle;
  1795. {$IF DEFINED(GLB_WIN)}
  1796. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1797. if Assigned(result) then
  1798. exit;
  1799. if Assigned(wglGetProcAddress) then
  1800. result := wglGetProcAddress(aProcName);
  1801. {$ELSEIF DEFINED(GLB_LINUX)}
  1802. if Assigned(glXGetProcAddress) then begin
  1803. result := glXGetProcAddress(aProcName);
  1804. if Assigned(result) then
  1805. exit;
  1806. end;
  1807. if Assigned(glXGetProcAddressARB) then begin
  1808. result := glXGetProcAddressARB(aProcName);
  1809. if Assigned(result) then
  1810. exit;
  1811. end;
  1812. result := dlsym(aLibHandle, aProcName);
  1813. {$IFEND}
  1814. if not Assigned(result) and aRaiseOnErr then
  1815. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1816. end;
  1817. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1818. var
  1819. GLU_LibHandle: Pointer = nil;
  1820. OpenGLInitialized: Boolean;
  1821. InitOpenGLCS: TCriticalSection;
  1822. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1823. procedure glbInitOpenGL;
  1824. ////////////////////////////////////////////////////////////////////////////////
  1825. function glbLoadLibrary(const aName: PChar): Pointer;
  1826. begin
  1827. {$IF DEFINED(GLB_WIN)}
  1828. result := {%H-}Pointer(LoadLibrary(aName));
  1829. {$ELSEIF DEFINED(GLB_LINUX)}
  1830. result := dlopen(Name, RTLD_LAZY);
  1831. {$ELSE}
  1832. result := nil;
  1833. {$IFEND}
  1834. end;
  1835. ////////////////////////////////////////////////////////////////////////////////
  1836. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1837. begin
  1838. result := false;
  1839. if not Assigned(aLibHandle) then
  1840. exit;
  1841. {$IF DEFINED(GLB_WIN)}
  1842. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1843. {$ELSEIF DEFINED(GLB_LINUX)}
  1844. Result := dlclose(aLibHandle) = 0;
  1845. {$IFEND}
  1846. end;
  1847. begin
  1848. if Assigned(GL_LibHandle) then
  1849. glbFreeLibrary(GL_LibHandle);
  1850. if Assigned(GLU_LibHandle) then
  1851. glbFreeLibrary(GLU_LibHandle);
  1852. GL_LibHandle := glbLoadLibrary(libopengl);
  1853. if not Assigned(GL_LibHandle) then
  1854. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1855. GLU_LibHandle := glbLoadLibrary(libglu);
  1856. if not Assigned(GLU_LibHandle) then
  1857. raise EglBitmap.Create('unable to load library: ' + libglu);
  1858. {$IF DEFINED(GLB_WIN)}
  1859. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1860. {$ELSEIF DEFINED(GLB_LINUX)}
  1861. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1862. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1863. {$IFEND}
  1864. glEnable := glbGetProcAddress('glEnable');
  1865. glDisable := glbGetProcAddress('glDisable');
  1866. glGetString := glbGetProcAddress('glGetString');
  1867. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1868. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1869. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1870. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1871. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1872. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1873. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1874. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1875. glTexGeni := glbGetProcAddress('glTexGeni');
  1876. glGenTextures := glbGetProcAddress('glGenTextures');
  1877. glBindTexture := glbGetProcAddress('glBindTexture');
  1878. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1879. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1880. glReadPixels := glbGetProcAddress('glReadPixels');
  1881. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1882. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1883. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1884. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1885. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1886. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1887. end;
  1888. {$ENDIF}
  1889. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1890. procedure glbReadOpenGLExtensions;
  1891. var
  1892. Buffer: AnsiString;
  1893. MajorVersion, MinorVersion: Integer;
  1894. ///////////////////////////////////////////////////////////////////////////////////////////
  1895. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1896. var
  1897. Separator: Integer;
  1898. begin
  1899. aMinor := 0;
  1900. aMajor := 0;
  1901. Separator := Pos(AnsiString('.'), aBuffer);
  1902. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1903. (aBuffer[Separator - 1] in ['0'..'9']) and
  1904. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1905. Dec(Separator);
  1906. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1907. Dec(Separator);
  1908. Delete(aBuffer, 1, Separator);
  1909. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1910. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1911. Inc(Separator);
  1912. Delete(aBuffer, Separator, 255);
  1913. Separator := Pos(AnsiString('.'), aBuffer);
  1914. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1915. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1916. end;
  1917. end;
  1918. ///////////////////////////////////////////////////////////////////////////////////////////
  1919. function CheckExtension(const Extension: AnsiString): Boolean;
  1920. var
  1921. ExtPos: Integer;
  1922. begin
  1923. ExtPos := Pos(Extension, Buffer);
  1924. result := ExtPos > 0;
  1925. if result then
  1926. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1927. end;
  1928. ///////////////////////////////////////////////////////////////////////////////////////////
  1929. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1930. begin
  1931. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1932. end;
  1933. begin
  1934. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1935. InitOpenGLCS.Enter;
  1936. try
  1937. if not OpenGLInitialized then begin
  1938. glbInitOpenGL;
  1939. OpenGLInitialized := true;
  1940. end;
  1941. finally
  1942. InitOpenGLCS.Leave;
  1943. end;
  1944. {$ENDIF}
  1945. // Version
  1946. Buffer := glGetString(GL_VERSION);
  1947. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1948. GL_VERSION_1_2 := CheckVersion(1, 2);
  1949. GL_VERSION_1_3 := CheckVersion(1, 3);
  1950. GL_VERSION_1_4 := CheckVersion(1, 4);
  1951. GL_VERSION_2_0 := CheckVersion(2, 0);
  1952. GL_VERSION_3_3 := CheckVersion(3, 3);
  1953. // Extensions
  1954. Buffer := glGetString(GL_EXTENSIONS);
  1955. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1956. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1957. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1958. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1959. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1960. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1961. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1962. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1963. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1964. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1965. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1966. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1967. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1968. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1969. if GL_VERSION_1_3 then begin
  1970. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1971. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1972. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1973. end else begin
  1974. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false);
  1975. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false);
  1976. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
  1977. end;
  1978. end;
  1979. {$ENDIF}
  1980. {$IFDEF GLB_SDL_IMAGE}
  1981. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1982. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1983. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1984. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1985. begin
  1986. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1987. end;
  1988. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1989. begin
  1990. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1991. end;
  1992. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1993. begin
  1994. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1995. end;
  1996. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1997. begin
  1998. result := 0;
  1999. end;
  2000. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  2001. begin
  2002. result := SDL_AllocRW;
  2003. if result = nil then
  2004. raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  2005. result^.seek := glBitmapRWseek;
  2006. result^.read := glBitmapRWread;
  2007. result^.write := glBitmapRWwrite;
  2008. result^.close := glBitmapRWclose;
  2009. result^.unknown.data1 := Stream;
  2010. end;
  2011. {$ENDIF}
  2012. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2013. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  2014. begin
  2015. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  2016. end;
  2017. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2018. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  2019. begin
  2020. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  2021. end;
  2022. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2023. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  2024. begin
  2025. glBitmapDefaultMipmap := aValue;
  2026. end;
  2027. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2028. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  2029. begin
  2030. glBitmapDefaultFormat := aFormat;
  2031. end;
  2032. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2033. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  2034. begin
  2035. glBitmapDefaultFilterMin := aMin;
  2036. glBitmapDefaultFilterMag := aMag;
  2037. end;
  2038. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2039. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  2040. begin
  2041. glBitmapDefaultWrapS := S;
  2042. glBitmapDefaultWrapT := T;
  2043. glBitmapDefaultWrapR := R;
  2044. end;
  2045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2046. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2047. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  2048. begin
  2049. glDefaultSwizzle[0] := r;
  2050. glDefaultSwizzle[1] := g;
  2051. glDefaultSwizzle[2] := b;
  2052. glDefaultSwizzle[3] := a;
  2053. end;
  2054. {$IFEND}
  2055. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2056. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  2057. begin
  2058. result := glBitmapDefaultDeleteTextureOnFree;
  2059. end;
  2060. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2061. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  2062. begin
  2063. result := glBitmapDefaultFreeDataAfterGenTextures;
  2064. end;
  2065. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2066. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  2067. begin
  2068. result := glBitmapDefaultMipmap;
  2069. end;
  2070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2071. function glBitmapGetDefaultFormat: TglBitmapFormat;
  2072. begin
  2073. result := glBitmapDefaultFormat;
  2074. end;
  2075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2076. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  2077. begin
  2078. aMin := glBitmapDefaultFilterMin;
  2079. aMag := glBitmapDefaultFilterMag;
  2080. end;
  2081. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2082. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  2083. begin
  2084. S := glBitmapDefaultWrapS;
  2085. T := glBitmapDefaultWrapT;
  2086. R := glBitmapDefaultWrapR;
  2087. end;
  2088. {$IFNDEF OPENGL_ES}
  2089. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2090. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  2091. begin
  2092. r := glDefaultSwizzle[0];
  2093. g := glDefaultSwizzle[1];
  2094. b := glDefaultSwizzle[2];
  2095. a := glDefaultSwizzle[3];
  2096. end;
  2097. {$ENDIF}
  2098. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2099. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2100. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2101. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  2102. var
  2103. w, h: Integer;
  2104. begin
  2105. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  2106. w := Max(1, aSize.X);
  2107. h := Max(1, aSize.Y);
  2108. result := GetSize(w, h);
  2109. end else
  2110. result := 0;
  2111. end;
  2112. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2113. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  2114. begin
  2115. result := 0;
  2116. if (aWidth <= 0) or (aHeight <= 0) then
  2117. exit;
  2118. result := Ceil(aWidth * aHeight * BytesPerPixel);
  2119. end;
  2120. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2121. function TFormatDescriptor.CreateMappingData: Pointer;
  2122. begin
  2123. result := nil;
  2124. end;
  2125. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2126. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2127. begin
  2128. //DUMMY
  2129. end;
  2130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2131. function TFormatDescriptor.IsEmpty: Boolean;
  2132. begin
  2133. result := (fFormat = tfEmpty);
  2134. end;
  2135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2136. function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
  2137. var
  2138. i: Integer;
  2139. m: TglBitmapRec4ul;
  2140. begin
  2141. result := false;
  2142. if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
  2143. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2144. m := Mask;
  2145. for i := 0 to 3 do
  2146. if (aMask.arr[i] <> m.arr[i]) then
  2147. exit;
  2148. result := true;
  2149. end;
  2150. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2151. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2152. begin
  2153. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2154. aPixel.Data := Range;
  2155. aPixel.Format := fFormat;
  2156. aPixel.Range := Range;
  2157. end;
  2158. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2159. constructor TFormatDescriptor.Create;
  2160. begin
  2161. inherited Create;
  2162. end;
  2163. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2164. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2165. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2166. procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2167. begin
  2168. aData^ := aPixel.Data.a;
  2169. inc(aData);
  2170. end;
  2171. procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2172. begin
  2173. aPixel.Data.r := 0;
  2174. aPixel.Data.g := 0;
  2175. aPixel.Data.b := 0;
  2176. aPixel.Data.a := aData^;
  2177. inc(aData);
  2178. end;
  2179. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2180. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2181. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2182. procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2183. begin
  2184. aData^ := LuminanceWeight(aPixel);
  2185. inc(aData);
  2186. end;
  2187. procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2188. begin
  2189. aPixel.Data.r := aData^;
  2190. aPixel.Data.g := aData^;
  2191. aPixel.Data.b := aData^;
  2192. aPixel.Data.a := 0;
  2193. inc(aData);
  2194. end;
  2195. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2196. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2197. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2198. procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2199. var
  2200. i: Integer;
  2201. begin
  2202. aData^ := 0;
  2203. for i := 0 to 3 do
  2204. if (Range.arr[i] > 0) then
  2205. aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2206. inc(aData);
  2207. end;
  2208. procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2209. var
  2210. i: Integer;
  2211. begin
  2212. for i := 0 to 3 do
  2213. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
  2214. inc(aData);
  2215. end;
  2216. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2217. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2218. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2219. procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2220. begin
  2221. inherited Map(aPixel, aData, aMapData);
  2222. aData^ := aPixel.Data.a;
  2223. inc(aData);
  2224. end;
  2225. procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2226. begin
  2227. inherited Unmap(aData, aPixel, aMapData);
  2228. aPixel.Data.a := aData^;
  2229. inc(aData);
  2230. end;
  2231. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2232. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2233. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2234. procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2235. begin
  2236. aData^ := aPixel.Data.r;
  2237. inc(aData);
  2238. aData^ := aPixel.Data.g;
  2239. inc(aData);
  2240. aData^ := aPixel.Data.b;
  2241. inc(aData);
  2242. end;
  2243. procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2244. begin
  2245. aPixel.Data.r := aData^;
  2246. inc(aData);
  2247. aPixel.Data.g := aData^;
  2248. inc(aData);
  2249. aPixel.Data.b := aData^;
  2250. inc(aData);
  2251. aPixel.Data.a := 0;
  2252. end;
  2253. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2254. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2255. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2256. procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2257. begin
  2258. aData^ := aPixel.Data.b;
  2259. inc(aData);
  2260. aData^ := aPixel.Data.g;
  2261. inc(aData);
  2262. aData^ := aPixel.Data.r;
  2263. inc(aData);
  2264. end;
  2265. procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2266. begin
  2267. aPixel.Data.b := aData^;
  2268. inc(aData);
  2269. aPixel.Data.g := aData^;
  2270. inc(aData);
  2271. aPixel.Data.r := aData^;
  2272. inc(aData);
  2273. aPixel.Data.a := 0;
  2274. end;
  2275. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2276. //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2277. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2278. procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2279. begin
  2280. inherited Map(aPixel, aData, aMapData);
  2281. aData^ := aPixel.Data.a;
  2282. inc(aData);
  2283. end;
  2284. procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2285. begin
  2286. inherited Unmap(aData, aPixel, aMapData);
  2287. aPixel.Data.a := aData^;
  2288. inc(aData);
  2289. end;
  2290. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2291. //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2292. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2293. procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2294. begin
  2295. inherited Map(aPixel, aData, aMapData);
  2296. aData^ := aPixel.Data.a;
  2297. inc(aData);
  2298. end;
  2299. procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2300. begin
  2301. inherited Unmap(aData, aPixel, aMapData);
  2302. aPixel.Data.a := aData^;
  2303. inc(aData);
  2304. end;
  2305. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2306. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2307. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2308. procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2309. begin
  2310. PWord(aData)^ := aPixel.Data.a;
  2311. inc(aData, 2);
  2312. end;
  2313. procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2314. begin
  2315. aPixel.Data.r := 0;
  2316. aPixel.Data.g := 0;
  2317. aPixel.Data.b := 0;
  2318. aPixel.Data.a := PWord(aData)^;
  2319. inc(aData, 2);
  2320. end;
  2321. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2322. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2323. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2324. procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2325. begin
  2326. PWord(aData)^ := LuminanceWeight(aPixel);
  2327. inc(aData, 2);
  2328. end;
  2329. procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2330. begin
  2331. aPixel.Data.r := PWord(aData)^;
  2332. aPixel.Data.g := PWord(aData)^;
  2333. aPixel.Data.b := PWord(aData)^;
  2334. aPixel.Data.a := 0;
  2335. inc(aData, 2);
  2336. end;
  2337. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2338. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2339. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2340. procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2341. var
  2342. i: Integer;
  2343. begin
  2344. PWord(aData)^ := 0;
  2345. for i := 0 to 3 do
  2346. if (Range.arr[i] > 0) then
  2347. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2348. inc(aData, 2);
  2349. end;
  2350. procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2351. var
  2352. i: Integer;
  2353. begin
  2354. for i := 0 to 3 do
  2355. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2356. inc(aData, 2);
  2357. end;
  2358. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2359. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2360. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2361. procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2362. begin
  2363. PWord(aData)^ := DepthWeight(aPixel);
  2364. inc(aData, 2);
  2365. end;
  2366. procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2367. begin
  2368. aPixel.Data.r := PWord(aData)^;
  2369. aPixel.Data.g := PWord(aData)^;
  2370. aPixel.Data.b := PWord(aData)^;
  2371. aPixel.Data.a := PWord(aData)^;;
  2372. inc(aData, 2);
  2373. end;
  2374. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2375. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2376. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2377. procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2378. begin
  2379. inherited Map(aPixel, aData, aMapData);
  2380. PWord(aData)^ := aPixel.Data.a;
  2381. inc(aData, 2);
  2382. end;
  2383. procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2384. begin
  2385. inherited Unmap(aData, aPixel, aMapData);
  2386. aPixel.Data.a := PWord(aData)^;
  2387. inc(aData, 2);
  2388. end;
  2389. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2390. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2391. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2392. procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2393. begin
  2394. PWord(aData)^ := aPixel.Data.r;
  2395. inc(aData, 2);
  2396. PWord(aData)^ := aPixel.Data.g;
  2397. inc(aData, 2);
  2398. PWord(aData)^ := aPixel.Data.b;
  2399. inc(aData, 2);
  2400. end;
  2401. procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2402. begin
  2403. aPixel.Data.r := PWord(aData)^;
  2404. inc(aData, 2);
  2405. aPixel.Data.g := PWord(aData)^;
  2406. inc(aData, 2);
  2407. aPixel.Data.b := PWord(aData)^;
  2408. inc(aData, 2);
  2409. aPixel.Data.a := 0;
  2410. end;
  2411. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2412. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2413. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2414. procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2415. begin
  2416. PWord(aData)^ := aPixel.Data.b;
  2417. inc(aData, 2);
  2418. PWord(aData)^ := aPixel.Data.g;
  2419. inc(aData, 2);
  2420. PWord(aData)^ := aPixel.Data.r;
  2421. inc(aData, 2);
  2422. end;
  2423. procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2424. begin
  2425. aPixel.Data.b := PWord(aData)^;
  2426. inc(aData, 2);
  2427. aPixel.Data.g := PWord(aData)^;
  2428. inc(aData, 2);
  2429. aPixel.Data.r := PWord(aData)^;
  2430. inc(aData, 2);
  2431. aPixel.Data.a := 0;
  2432. end;
  2433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2434. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2435. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2436. procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2437. begin
  2438. inherited Map(aPixel, aData, aMapData);
  2439. PWord(aData)^ := aPixel.Data.a;
  2440. inc(aData, 2);
  2441. end;
  2442. procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2443. begin
  2444. inherited Unmap(aData, aPixel, aMapData);
  2445. aPixel.Data.a := PWord(aData)^;
  2446. inc(aData, 2);
  2447. end;
  2448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2449. //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2450. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2451. procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2452. begin
  2453. PWord(aData)^ := aPixel.Data.a;
  2454. inc(aData, 2);
  2455. inherited Map(aPixel, aData, aMapData);
  2456. end;
  2457. procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2458. begin
  2459. aPixel.Data.a := PWord(aData)^;
  2460. inc(aData, 2);
  2461. inherited Unmap(aData, aPixel, aMapData);
  2462. end;
  2463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2464. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2466. procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2467. begin
  2468. inherited Map(aPixel, aData, aMapData);
  2469. PWord(aData)^ := aPixel.Data.a;
  2470. inc(aData, 2);
  2471. end;
  2472. procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2473. begin
  2474. inherited Unmap(aData, aPixel, aMapData);
  2475. aPixel.Data.a := PWord(aData)^;
  2476. inc(aData, 2);
  2477. end;
  2478. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2479. //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2480. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2481. procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2482. begin
  2483. PWord(aData)^ := aPixel.Data.a;
  2484. inc(aData, 2);
  2485. inherited Map(aPixel, aData, aMapData);
  2486. end;
  2487. procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2488. begin
  2489. aPixel.Data.a := PWord(aData)^;
  2490. inc(aData, 2);
  2491. inherited Unmap(aData, aPixel, aMapData);
  2492. end;
  2493. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2494. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2495. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2496. procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2497. var
  2498. i: Integer;
  2499. begin
  2500. PCardinal(aData)^ := 0;
  2501. for i := 0 to 3 do
  2502. if (Range.arr[i] > 0) then
  2503. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2504. inc(aData, 4);
  2505. end;
  2506. procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2507. var
  2508. i: Integer;
  2509. begin
  2510. for i := 0 to 3 do
  2511. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2512. inc(aData, 2);
  2513. end;
  2514. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2515. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2516. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2517. procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2518. begin
  2519. PCardinal(aData)^ := DepthWeight(aPixel);
  2520. inc(aData, 4);
  2521. end;
  2522. procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2523. begin
  2524. aPixel.Data.r := PCardinal(aData)^;
  2525. aPixel.Data.g := PCardinal(aData)^;
  2526. aPixel.Data.b := PCardinal(aData)^;
  2527. aPixel.Data.a := PCardinal(aData)^;
  2528. inc(aData, 4);
  2529. end;
  2530. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2531. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2532. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2533. procedure TfdAlpha4ub1.SetValues;
  2534. begin
  2535. inherited SetValues;
  2536. fBitsPerPixel := 8;
  2537. fFormat := tfAlpha4ub1;
  2538. fWithAlpha := tfAlpha4ub1;
  2539. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2540. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2541. {$IFNDEF OPENGL_ES}
  2542. fOpenGLFormat := tfAlpha4ub1;
  2543. fglFormat := GL_ALPHA;
  2544. fglInternalFormat := GL_ALPHA4;
  2545. fglDataFormat := GL_UNSIGNED_BYTE;
  2546. {$ELSE}
  2547. fOpenGLFormat := tfAlpha8ub1;
  2548. {$ENDIF}
  2549. end;
  2550. procedure TfdAlpha8ub1.SetValues;
  2551. begin
  2552. inherited SetValues;
  2553. fBitsPerPixel := 8;
  2554. fFormat := tfAlpha8ub1;
  2555. fWithAlpha := tfAlpha8ub1;
  2556. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2557. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2558. fOpenGLFormat := tfAlpha8ub1;
  2559. fglFormat := GL_ALPHA;
  2560. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
  2561. fglDataFormat := GL_UNSIGNED_BYTE;
  2562. end;
  2563. procedure TfdAlpha16us1.SetValues;
  2564. begin
  2565. inherited SetValues;
  2566. fBitsPerPixel := 16;
  2567. fFormat := tfAlpha16us1;
  2568. fWithAlpha := tfAlpha16us1;
  2569. fPrecision := glBitmapRec4ub(0, 0, 0, 16);
  2570. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2571. {$IFNDEF OPENGL_ES}
  2572. fOpenGLFormat := tfAlpha16us1;
  2573. fglFormat := GL_ALPHA;
  2574. fglInternalFormat := GL_ALPHA16;
  2575. fglDataFormat := GL_UNSIGNED_SHORT;
  2576. {$ELSE}
  2577. fOpenGLFormat := tfAlpha8ub1;
  2578. {$ENDIF}
  2579. end;
  2580. procedure TfdLuminance4ub1.SetValues;
  2581. begin
  2582. inherited SetValues;
  2583. fBitsPerPixel := 8;
  2584. fFormat := tfLuminance4ub1;
  2585. fWithAlpha := tfLuminance4Alpha4ub2;
  2586. fWithoutAlpha := tfLuminance4ub1;
  2587. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2588. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2589. {$IFNDEF OPENGL_ES}
  2590. fOpenGLFormat := tfLuminance4ub1;
  2591. fglFormat := GL_LUMINANCE;
  2592. fglInternalFormat := GL_LUMINANCE4;
  2593. fglDataFormat := GL_UNSIGNED_BYTE;
  2594. {$ELSE}
  2595. fOpenGLFormat := tfLuminance8ub1;
  2596. {$ENDIF}
  2597. end;
  2598. procedure TfdLuminance8ub1.SetValues;
  2599. begin
  2600. inherited SetValues;
  2601. fBitsPerPixel := 8;
  2602. fFormat := tfLuminance8ub1;
  2603. fWithAlpha := tfLuminance8Alpha8ub2;
  2604. fWithoutAlpha := tfLuminance8ub1;
  2605. fOpenGLFormat := tfLuminance8ub1;
  2606. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2607. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2608. fglFormat := GL_LUMINANCE;
  2609. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
  2610. fglDataFormat := GL_UNSIGNED_BYTE;
  2611. end;
  2612. procedure TfdLuminance16us1.SetValues;
  2613. begin
  2614. inherited SetValues;
  2615. fBitsPerPixel := 16;
  2616. fFormat := tfLuminance16us1;
  2617. fWithAlpha := tfLuminance16Alpha16us2;
  2618. fWithoutAlpha := tfLuminance16us1;
  2619. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2620. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  2621. {$IFNDEF OPENGL_ES}
  2622. fOpenGLFormat := tfLuminance16us1;
  2623. fglFormat := GL_LUMINANCE;
  2624. fglInternalFormat := GL_LUMINANCE16;
  2625. fglDataFormat := GL_UNSIGNED_SHORT;
  2626. {$ELSE}
  2627. fOpenGLFormat := tfLuminance8ub1;
  2628. {$ENDIF}
  2629. end;
  2630. procedure TfdLuminance4Alpha4ub2.SetValues;
  2631. begin
  2632. inherited SetValues;
  2633. fBitsPerPixel := 16;
  2634. fFormat := tfLuminance4Alpha4ub2;
  2635. fWithAlpha := tfLuminance4Alpha4ub2;
  2636. fWithoutAlpha := tfLuminance4ub1;
  2637. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2638. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2639. {$IFNDEF OPENGL_ES}
  2640. fOpenGLFormat := tfLuminance4Alpha4ub2;
  2641. fglFormat := GL_LUMINANCE_ALPHA;
  2642. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2643. fglDataFormat := GL_UNSIGNED_BYTE;
  2644. {$ELSE}
  2645. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2646. {$ENDIF}
  2647. end;
  2648. procedure TfdLuminance6Alpha2ub2.SetValues;
  2649. begin
  2650. inherited SetValues;
  2651. fBitsPerPixel := 16;
  2652. fFormat := tfLuminance6Alpha2ub2;
  2653. fWithAlpha := tfLuminance6Alpha2ub2;
  2654. fWithoutAlpha := tfLuminance8ub1;
  2655. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2656. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2657. {$IFNDEF OPENGL_ES}
  2658. fOpenGLFormat := tfLuminance6Alpha2ub2;
  2659. fglFormat := GL_LUMINANCE_ALPHA;
  2660. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2661. fglDataFormat := GL_UNSIGNED_BYTE;
  2662. {$ELSE}
  2663. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2664. {$ENDIF}
  2665. end;
  2666. procedure TfdLuminance8Alpha8ub2.SetValues;
  2667. begin
  2668. inherited SetValues;
  2669. fBitsPerPixel := 16;
  2670. fFormat := tfLuminance8Alpha8ub2;
  2671. fWithAlpha := tfLuminance8Alpha8ub2;
  2672. fWithoutAlpha := tfLuminance8ub1;
  2673. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2674. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2675. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2676. fglFormat := GL_LUMINANCE_ALPHA;
  2677. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
  2678. fglDataFormat := GL_UNSIGNED_BYTE;
  2679. end;
  2680. procedure TfdLuminance12Alpha4us2.SetValues;
  2681. begin
  2682. inherited SetValues;
  2683. fBitsPerPixel := 32;
  2684. fFormat := tfLuminance12Alpha4us2;
  2685. fWithAlpha := tfLuminance12Alpha4us2;
  2686. fWithoutAlpha := tfLuminance16us1;
  2687. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2688. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2689. {$IFNDEF OPENGL_ES}
  2690. fOpenGLFormat := tfLuminance12Alpha4us2;
  2691. fglFormat := GL_LUMINANCE_ALPHA;
  2692. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2693. fglDataFormat := GL_UNSIGNED_SHORT;
  2694. {$ELSE}
  2695. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2696. {$ENDIF}
  2697. end;
  2698. procedure TfdLuminance16Alpha16us2.SetValues;
  2699. begin
  2700. inherited SetValues;
  2701. fBitsPerPixel := 32;
  2702. fFormat := tfLuminance16Alpha16us2;
  2703. fWithAlpha := tfLuminance16Alpha16us2;
  2704. fWithoutAlpha := tfLuminance16us1;
  2705. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2706. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2707. {$IFNDEF OPENGL_ES}
  2708. fOpenGLFormat := tfLuminance16Alpha16us2;
  2709. fglFormat := GL_LUMINANCE_ALPHA;
  2710. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2711. fglDataFormat := GL_UNSIGNED_SHORT;
  2712. {$ELSE}
  2713. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2714. {$ENDIF}
  2715. end;
  2716. procedure TfdR3G3B2ub1.SetValues;
  2717. begin
  2718. inherited SetValues;
  2719. fBitsPerPixel := 8;
  2720. fFormat := tfR3G3B2ub1;
  2721. fWithAlpha := tfRGBA4us1;
  2722. fWithoutAlpha := tfR3G3B2ub1;
  2723. fRGBInverted := tfEmpty;
  2724. fPrecision := glBitmapRec4ub(3, 3, 2, 0);
  2725. fShift := glBitmapRec4ub(5, 2, 0, 0);
  2726. {$IFNDEF OPENGL_ES}
  2727. fOpenGLFormat := tfR3G3B2ub1;
  2728. fglFormat := GL_RGB;
  2729. fglInternalFormat := GL_R3_G3_B2;
  2730. fglDataFormat := GL_UNSIGNED_BYTE_3_3_2;
  2731. {$ELSE}
  2732. fOpenGLFormat := tfR5G6B5us1;
  2733. {$ENDIF}
  2734. end;
  2735. procedure TfdRGBX4us1.SetValues;
  2736. begin
  2737. inherited SetValues;
  2738. fBitsPerPixel := 16;
  2739. fFormat := tfRGBX4us1;
  2740. fWithAlpha := tfRGBA4us1;
  2741. fWithoutAlpha := tfRGBX4us1;
  2742. fRGBInverted := tfBGRX4us1;
  2743. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2744. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2745. {$IFNDEF OPENGL_ES}
  2746. fOpenGLFormat := tfRGBX4us1;
  2747. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2748. fglInternalFormat := GL_RGB4;
  2749. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2750. {$ELSE}
  2751. fOpenGLFormat := tfR5G6B5us1;
  2752. {$ENDIF}
  2753. end;
  2754. procedure TfdXRGB4us1.SetValues;
  2755. begin
  2756. inherited SetValues;
  2757. fBitsPerPixel := 16;
  2758. fFormat := tfXRGB4us1;
  2759. fWithAlpha := tfARGB4us1;
  2760. fWithoutAlpha := tfXRGB4us1;
  2761. fRGBInverted := tfXBGR4us1;
  2762. fPrecision := glBitmapRec4ub(4, 4, 4, 0);
  2763. fShift := glBitmapRec4ub(8, 4, 0, 0);
  2764. {$IFNDEF OPENGL_ES}
  2765. fOpenGLFormat := tfXRGB4us1;
  2766. fglFormat := GL_BGRA;
  2767. fglInternalFormat := GL_RGB4;
  2768. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2769. {$ELSE}
  2770. fOpenGLFormat := tfR5G6B5us1;
  2771. {$ENDIF}
  2772. end;
  2773. procedure TfdR5G6B5us1.SetValues;
  2774. begin
  2775. inherited SetValues;
  2776. fBitsPerPixel := 16;
  2777. fFormat := tfR5G6B5us1;
  2778. fWithAlpha := tfRGB5A1us1;
  2779. fWithoutAlpha := tfR5G6B5us1;
  2780. fRGBInverted := tfB5G6R5us1;
  2781. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2782. fShift := glBitmapRec4ub(11, 5, 0, 0);
  2783. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  2784. fOpenGLFormat := tfR5G6B5us1;
  2785. fglFormat := GL_RGB;
  2786. fglInternalFormat := GL_RGB565;
  2787. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2788. {$ELSE}
  2789. fOpenGLFormat := tfRGB8ub3;
  2790. {$IFEND}
  2791. end;
  2792. procedure TfdRGB5X1us1.SetValues;
  2793. begin
  2794. inherited SetValues;
  2795. fBitsPerPixel := 16;
  2796. fFormat := tfRGB5X1us1;
  2797. fWithAlpha := tfRGB5A1us1;
  2798. fWithoutAlpha := tfRGB5X1us1;
  2799. fRGBInverted := tfBGR5X1us1;
  2800. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2801. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2802. {$IFNDEF OPENGL_ES}
  2803. fOpenGLFormat := tfRGB5X1us1;
  2804. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2805. fglInternalFormat := GL_RGB5;
  2806. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2807. {$ELSE}
  2808. fOpenGLFormat := tfR5G6B5us1;
  2809. {$ENDIF}
  2810. end;
  2811. procedure TfdX1RGB5us1.SetValues;
  2812. begin
  2813. inherited SetValues;
  2814. fBitsPerPixel := 16;
  2815. fFormat := tfX1RGB5us1;
  2816. fWithAlpha := tfA1RGB5us1;
  2817. fWithoutAlpha := tfX1RGB5us1;
  2818. fRGBInverted := tfX1BGR5us1;
  2819. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2820. fShift := glBitmapRec4ub(10, 5, 0, 0);
  2821. {$IFNDEF OPENGL_ES}
  2822. fOpenGLFormat := tfX1RGB5us1;
  2823. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2824. fglInternalFormat := GL_RGB5;
  2825. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2826. {$ELSE}
  2827. fOpenGLFormat := tfR5G6B5us1;
  2828. {$ENDIF}
  2829. end;
  2830. procedure TfdRGB8ub3.SetValues;
  2831. begin
  2832. inherited SetValues;
  2833. fBitsPerPixel := 24;
  2834. fFormat := tfRGB8ub3;
  2835. fWithAlpha := tfRGBA8ub4;
  2836. fWithoutAlpha := tfRGB8ub3;
  2837. fRGBInverted := tfBGR8ub3;
  2838. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2839. fShift := glBitmapRec4ub(0, 8, 16, 0);
  2840. fOpenGLFormat := tfRGB8ub3;
  2841. fglFormat := GL_RGB;
  2842. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
  2843. fglDataFormat := GL_UNSIGNED_BYTE;
  2844. end;
  2845. procedure TfdRGBX8ui1.SetValues;
  2846. begin
  2847. inherited SetValues;
  2848. fBitsPerPixel := 32;
  2849. fFormat := tfRGBX8ui1;
  2850. fWithAlpha := tfRGBA8ui1;
  2851. fWithoutAlpha := tfRGBX8ui1;
  2852. fRGBInverted := tfBGRX8ui1;
  2853. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2854. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2855. {$IFNDEF OPENGL_ES}
  2856. fOpenGLFormat := tfRGBX8ui1;
  2857. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2858. fglInternalFormat := GL_RGB8;
  2859. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2860. {$ELSE}
  2861. fOpenGLFormat := tfRGB8ub3;
  2862. {$ENDIF}
  2863. end;
  2864. procedure TfdXRGB8ui1.SetValues;
  2865. begin
  2866. inherited SetValues;
  2867. fBitsPerPixel := 32;
  2868. fFormat := tfXRGB8ui1;
  2869. fWithAlpha := tfXRGB8ui1;
  2870. fWithoutAlpha := tfXRGB8ui1;
  2871. fOpenGLFormat := tfXRGB8ui1;
  2872. fRGBInverted := tfXBGR8ui1;
  2873. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2874. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2875. {$IFNDEF OPENGL_ES}
  2876. fOpenGLFormat := tfXRGB8ui1;
  2877. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2878. fglInternalFormat := GL_RGB8;
  2879. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2880. {$ELSE}
  2881. fOpenGLFormat := tfRGB8ub3;
  2882. {$ENDIF}
  2883. end;
  2884. procedure TfdRGB10X2ui1.SetValues;
  2885. begin
  2886. inherited SetValues;
  2887. fBitsPerPixel := 32;
  2888. fFormat := tfRGB10X2ui1;
  2889. fWithAlpha := tfRGB10A2ui1;
  2890. fWithoutAlpha := tfRGB10X2ui1;
  2891. fRGBInverted := tfBGR10X2ui1;
  2892. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2893. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2894. {$IFNDEF OPENGL_ES}
  2895. fOpenGLFormat := tfRGB10X2ui1;
  2896. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2897. fglInternalFormat := GL_RGB10;
  2898. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2899. {$ELSE}
  2900. fOpenGLFormat := tfRGB16us3;
  2901. {$ENDIF}
  2902. end;
  2903. procedure TfdX2RGB10ui1.SetValues;
  2904. begin
  2905. inherited SetValues;
  2906. fBitsPerPixel := 32;
  2907. fFormat := tfX2RGB10ui1;
  2908. fWithAlpha := tfA2RGB10ui1;
  2909. fWithoutAlpha := tfX2RGB10ui1;
  2910. fRGBInverted := tfX2BGR10ui1;
  2911. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2912. fShift := glBitmapRec4ub(20, 10, 0, 0);
  2913. {$IFNDEF OPENGL_ES}
  2914. fOpenGLFormat := tfX2RGB10ui1;
  2915. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2916. fglInternalFormat := GL_RGB10;
  2917. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2918. {$ELSE}
  2919. fOpenGLFormat := tfRGB16us3;
  2920. {$ENDIF}
  2921. end;
  2922. procedure TfdRGB16us3.SetValues;
  2923. begin
  2924. inherited SetValues;
  2925. fBitsPerPixel := 48;
  2926. fFormat := tfRGB16us3;
  2927. fWithAlpha := tfRGBA16us4;
  2928. fWithoutAlpha := tfRGB16us3;
  2929. fRGBInverted := tfBGR16us3;
  2930. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2931. fShift := glBitmapRec4ub( 0, 16, 32, 0);
  2932. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2933. fOpenGLFormat := tfRGB16us3;
  2934. fglFormat := GL_RGB;
  2935. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
  2936. fglDataFormat := GL_UNSIGNED_SHORT;
  2937. {$ELSE}
  2938. fOpenGLFormat := tfRGB8ub3;
  2939. {$IFEND}
  2940. end;
  2941. procedure TfdRGBA4us1.SetValues;
  2942. begin
  2943. inherited SetValues;
  2944. fBitsPerPixel := 16;
  2945. fFormat := tfRGBA4us1;
  2946. fWithAlpha := tfRGBA4us1;
  2947. fWithoutAlpha := tfRGBX4us1;
  2948. fOpenGLFormat := tfRGBA4us1;
  2949. fRGBInverted := tfBGRA4us1;
  2950. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2951. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2952. fglFormat := GL_RGBA;
  2953. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2954. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2955. end;
  2956. procedure TfdARGB4us1.SetValues;
  2957. begin
  2958. inherited SetValues;
  2959. fBitsPerPixel := 16;
  2960. fFormat := tfARGB4us1;
  2961. fWithAlpha := tfARGB4us1;
  2962. fWithoutAlpha := tfXRGB4us1;
  2963. fRGBInverted := tfABGR4us1;
  2964. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2965. fShift := glBitmapRec4ub( 8, 4, 0, 12);
  2966. {$IFNDEF OPENGL_ES}
  2967. fOpenGLFormat := tfARGB4us1;
  2968. fglFormat := GL_BGRA;
  2969. fglInternalFormat := GL_RGBA4;
  2970. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2971. {$ELSE}
  2972. fOpenGLFormat := tfRGBA4us1;
  2973. {$ENDIF}
  2974. end;
  2975. procedure TfdRGB5A1us1.SetValues;
  2976. begin
  2977. inherited SetValues;
  2978. fBitsPerPixel := 16;
  2979. fFormat := tfRGB5A1us1;
  2980. fWithAlpha := tfRGB5A1us1;
  2981. fWithoutAlpha := tfRGB5X1us1;
  2982. fOpenGLFormat := tfRGB5A1us1;
  2983. fRGBInverted := tfBGR5A1us1;
  2984. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2985. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2986. fglFormat := GL_RGBA;
  2987. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
  2988. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2989. end;
  2990. procedure TfdA1RGB5us1.SetValues;
  2991. begin
  2992. inherited SetValues;
  2993. fBitsPerPixel := 16;
  2994. fFormat := tfA1RGB5us1;
  2995. fWithAlpha := tfA1RGB5us1;
  2996. fWithoutAlpha := tfX1RGB5us1;
  2997. fRGBInverted := tfA1BGR5us1;
  2998. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2999. fShift := glBitmapRec4ub(10, 5, 0, 15);
  3000. {$IFNDEF OPENGL_ES}
  3001. fOpenGLFormat := tfA1RGB5us1;
  3002. fglFormat := GL_BGRA;
  3003. fglInternalFormat := GL_RGB5_A1;
  3004. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3005. {$ELSE}
  3006. fOpenGLFormat := tfRGB5A1us1;
  3007. {$ENDIF}
  3008. end;
  3009. procedure TfdRGBA8ui1.SetValues;
  3010. begin
  3011. inherited SetValues;
  3012. fBitsPerPixel := 32;
  3013. fFormat := tfRGBA8ui1;
  3014. fWithAlpha := tfRGBA8ui1;
  3015. fWithoutAlpha := tfRGBX8ui1;
  3016. fRGBInverted := tfBGRA8ui1;
  3017. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3018. fShift := glBitmapRec4ub(24, 16, 8, 0);
  3019. {$IFNDEF OPENGL_ES}
  3020. fOpenGLFormat := tfRGBA8ui1;
  3021. fglFormat := GL_RGBA;
  3022. fglInternalFormat := GL_RGBA8;
  3023. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3024. {$ELSE}
  3025. fOpenGLFormat := tfRGBA8ub4;
  3026. {$ENDIF}
  3027. end;
  3028. procedure TfdARGB8ui1.SetValues;
  3029. begin
  3030. inherited SetValues;
  3031. fBitsPerPixel := 32;
  3032. fFormat := tfARGB8ui1;
  3033. fWithAlpha := tfARGB8ui1;
  3034. fWithoutAlpha := tfXRGB8ui1;
  3035. fRGBInverted := tfABGR8ui1;
  3036. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3037. fShift := glBitmapRec4ub(16, 8, 0, 24);
  3038. {$IFNDEF OPENGL_ES}
  3039. fOpenGLFormat := tfARGB8ui1;
  3040. fglFormat := GL_BGRA;
  3041. fglInternalFormat := GL_RGBA8;
  3042. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3043. {$ELSE}
  3044. fOpenGLFormat := tfRGBA8ub4;
  3045. {$ENDIF}
  3046. end;
  3047. procedure TfdRGBA8ub4.SetValues;
  3048. begin
  3049. inherited SetValues;
  3050. fBitsPerPixel := 32;
  3051. fFormat := tfRGBA8ub4;
  3052. fWithAlpha := tfRGBA8ub4;
  3053. fWithoutAlpha := tfRGB8ub3;
  3054. fOpenGLFormat := tfRGBA8ub4;
  3055. fRGBInverted := tfBGRA8ub4;
  3056. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3057. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  3058. fglFormat := GL_RGBA;
  3059. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  3060. fglDataFormat := GL_UNSIGNED_BYTE;
  3061. end;
  3062. procedure TfdRGB10A2ui1.SetValues;
  3063. begin
  3064. inherited SetValues;
  3065. fBitsPerPixel := 32;
  3066. fFormat := tfRGB10A2ui1;
  3067. fWithAlpha := tfRGB10A2ui1;
  3068. fWithoutAlpha := tfRGB10X2ui1;
  3069. fRGBInverted := tfBGR10A2ui1;
  3070. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3071. fShift := glBitmapRec4ub(22, 12, 2, 0);
  3072. {$IFNDEF OPENGL_ES}
  3073. fOpenGLFormat := tfRGB10A2ui1;
  3074. fglFormat := GL_RGBA;
  3075. fglInternalFormat := GL_RGB10_A2;
  3076. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3077. {$ELSE}
  3078. fOpenGLFormat := tfA2RGB10ui1;
  3079. {$ENDIF}
  3080. end;
  3081. procedure TfdA2RGB10ui1.SetValues;
  3082. begin
  3083. inherited SetValues;
  3084. fBitsPerPixel := 32;
  3085. fFormat := tfA2RGB10ui1;
  3086. fWithAlpha := tfA2RGB10ui1;
  3087. fWithoutAlpha := tfX2RGB10ui1;
  3088. fRGBInverted := tfA2BGR10ui1;
  3089. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3090. fShift := glBitmapRec4ub(20, 10, 0, 30);
  3091. {$IF NOT DEFINED(OPENGL_ES)}
  3092. fOpenGLFormat := tfA2RGB10ui1;
  3093. fglFormat := GL_BGRA;
  3094. fglInternalFormat := GL_RGB10_A2;
  3095. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3096. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  3097. fOpenGLFormat := tfA2RGB10ui1;
  3098. fglFormat := GL_RGBA;
  3099. fglInternalFormat := GL_RGB10_A2;
  3100. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3101. {$ELSE}
  3102. fOpenGLFormat := tfRGBA8ui1;
  3103. {$IFEND}
  3104. end;
  3105. procedure TfdRGBA16us4.SetValues;
  3106. begin
  3107. inherited SetValues;
  3108. fBitsPerPixel := 64;
  3109. fFormat := tfRGBA16us4;
  3110. fWithAlpha := tfRGBA16us4;
  3111. fWithoutAlpha := tfRGB16us3;
  3112. fRGBInverted := tfBGRA16us4;
  3113. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3114. fShift := glBitmapRec4ub( 0, 16, 32, 48);
  3115. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  3116. fOpenGLFormat := tfRGBA16us4;
  3117. fglFormat := GL_RGBA;
  3118. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
  3119. fglDataFormat := GL_UNSIGNED_SHORT;
  3120. {$ELSE}
  3121. fOpenGLFormat := tfRGBA8ub4;
  3122. {$IFEND}
  3123. end;
  3124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3125. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3126. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3127. procedure TfdBGRX4us1.SetValues;
  3128. begin
  3129. inherited SetValues;
  3130. fBitsPerPixel := 16;
  3131. fFormat := tfBGRX4us1;
  3132. fWithAlpha := tfBGRA4us1;
  3133. fWithoutAlpha := tfBGRX4us1;
  3134. fRGBInverted := tfRGBX4us1;
  3135. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  3136. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  3137. {$IFNDEF OPENGL_ES}
  3138. fOpenGLFormat := tfBGRX4us1;
  3139. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3140. fglInternalFormat := GL_RGB4;
  3141. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3142. {$ELSE}
  3143. fOpenGLFormat := tfR5G6B5us1;
  3144. {$ENDIF}
  3145. end;
  3146. procedure TfdXBGR4us1.SetValues;
  3147. begin
  3148. inherited SetValues;
  3149. fBitsPerPixel := 16;
  3150. fFormat := tfXBGR4us1;
  3151. fWithAlpha := tfABGR4us1;
  3152. fWithoutAlpha := tfXBGR4us1;
  3153. fRGBInverted := tfXRGB4us1;
  3154. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  3155. fShift := glBitmapRec4ub( 0, 4, 8, 0);
  3156. {$IFNDEF OPENGL_ES}
  3157. fOpenGLFormat := tfXBGR4us1;
  3158. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3159. fglInternalFormat := GL_RGB4;
  3160. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3161. {$ELSE}
  3162. fOpenGLFormat := tfR5G6B5us1;
  3163. {$ENDIF}
  3164. end;
  3165. procedure TfdB5G6R5us1.SetValues;
  3166. begin
  3167. inherited SetValues;
  3168. fBitsPerPixel := 16;
  3169. fFormat := tfB5G6R5us1;
  3170. fWithAlpha := tfBGR5A1us1;
  3171. fWithoutAlpha := tfB5G6R5us1;
  3172. fRGBInverted := tfR5G6B5us1;
  3173. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  3174. fShift := glBitmapRec4ub( 0, 5, 11, 0);
  3175. {$IFNDEF OPENGL_ES}
  3176. fOpenGLFormat := tfB5G6R5us1;
  3177. fglFormat := GL_RGB;
  3178. fglInternalFormat := GL_RGB565;
  3179. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  3180. {$ELSE}
  3181. fOpenGLFormat := tfR5G6B5us1;
  3182. {$ENDIF}
  3183. end;
  3184. procedure TfdBGR5X1us1.SetValues;
  3185. begin
  3186. inherited SetValues;
  3187. fBitsPerPixel := 16;
  3188. fFormat := tfBGR5X1us1;
  3189. fWithAlpha := tfBGR5A1us1;
  3190. fWithoutAlpha := tfBGR5X1us1;
  3191. fRGBInverted := tfRGB5X1us1;
  3192. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  3193. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  3194. {$IFNDEF OPENGL_ES}
  3195. fOpenGLFormat := tfBGR5X1us1;
  3196. fglFormat := GL_BGRA;
  3197. fglInternalFormat := GL_RGB5;
  3198. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3199. {$ELSE}
  3200. fOpenGLFormat := tfR5G6B5us1;
  3201. {$ENDIF}
  3202. end;
  3203. procedure TfdX1BGR5us1.SetValues;
  3204. begin
  3205. inherited SetValues;
  3206. fBitsPerPixel := 16;
  3207. fFormat := tfX1BGR5us1;
  3208. fWithAlpha := tfA1BGR5us1;
  3209. fWithoutAlpha := tfX1BGR5us1;
  3210. fRGBInverted := tfX1RGB5us1;
  3211. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  3212. fShift := glBitmapRec4ub( 0, 5, 10, 0);
  3213. {$IFNDEF OPENGL_ES}
  3214. fOpenGLFormat := tfX1BGR5us1;
  3215. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3216. fglInternalFormat := GL_RGB5;
  3217. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3218. {$ELSE}
  3219. fOpenGLFormat := tfR5G6B5us1;
  3220. {$ENDIF}
  3221. end;
  3222. procedure TfdBGR8ub3.SetValues;
  3223. begin
  3224. inherited SetValues;
  3225. fBitsPerPixel := 24;
  3226. fFormat := tfBGR8ub3;
  3227. fWithAlpha := tfBGRA8ub4;
  3228. fWithoutAlpha := tfBGR8ub3;
  3229. fRGBInverted := tfRGB8ub3;
  3230. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  3231. fShift := glBitmapRec4ub(16, 8, 0, 0);
  3232. {$IFNDEF OPENGL_ES}
  3233. fOpenGLFormat := tfBGR8ub3;
  3234. fglFormat := GL_BGR;
  3235. fglInternalFormat := GL_RGB8;
  3236. fglDataFormat := GL_UNSIGNED_BYTE;
  3237. {$ELSE}
  3238. fOpenGLFormat := tfRGB8ub3;
  3239. {$ENDIF}
  3240. end;
  3241. procedure TfdBGRX8ui1.SetValues;
  3242. begin
  3243. inherited SetValues;
  3244. fBitsPerPixel := 32;
  3245. fFormat := tfBGRX8ui1;
  3246. fWithAlpha := tfBGRA8ui1;
  3247. fWithoutAlpha := tfBGRX8ui1;
  3248. fRGBInverted := tfRGBX8ui1;
  3249. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  3250. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  3251. {$IFNDEF OPENGL_ES}
  3252. fOpenGLFormat := tfBGRX8ui1;
  3253. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3254. fglInternalFormat := GL_RGB8;
  3255. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3256. {$ELSE}
  3257. fOpenGLFormat := tfRGB8ub3;
  3258. {$ENDIF}
  3259. end;
  3260. procedure TfdXBGR8ui1.SetValues;
  3261. begin
  3262. inherited SetValues;
  3263. fBitsPerPixel := 32;
  3264. fFormat := tfXBGR8ui1;
  3265. fWithAlpha := tfABGR8ui1;
  3266. fWithoutAlpha := tfXBGR8ui1;
  3267. fRGBInverted := tfXRGB8ui1;
  3268. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  3269. fShift := glBitmapRec4ub( 0, 8, 16, 0);
  3270. {$IFNDEF OPENGL_ES}
  3271. fOpenGLFormat := tfXBGR8ui1;
  3272. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3273. fglInternalFormat := GL_RGB8;
  3274. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3275. {$ELSE}
  3276. fOpenGLFormat := tfRGB8ub3;
  3277. {$ENDIF}
  3278. end;
  3279. procedure TfdBGR10X2ui1.SetValues;
  3280. begin
  3281. inherited SetValues;
  3282. fBitsPerPixel := 32;
  3283. fFormat := tfBGR10X2ui1;
  3284. fWithAlpha := tfBGR10A2ui1;
  3285. fWithoutAlpha := tfBGR10X2ui1;
  3286. fRGBInverted := tfRGB10X2ui1;
  3287. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  3288. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  3289. {$IFNDEF OPENGL_ES}
  3290. fOpenGLFormat := tfBGR10X2ui1;
  3291. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3292. fglInternalFormat := GL_RGB10;
  3293. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3294. {$ELSE}
  3295. fOpenGLFormat := tfRGB16us3;
  3296. {$ENDIF}
  3297. end;
  3298. procedure TfdX2BGR10ui1.SetValues;
  3299. begin
  3300. inherited SetValues;
  3301. fBitsPerPixel := 32;
  3302. fFormat := tfX2BGR10ui1;
  3303. fWithAlpha := tfA2BGR10ui1;
  3304. fWithoutAlpha := tfX2BGR10ui1;
  3305. fRGBInverted := tfX2RGB10ui1;
  3306. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  3307. fShift := glBitmapRec4ub( 0, 10, 20, 0);
  3308. {$IFNDEF OPENGL_ES}
  3309. fOpenGLFormat := tfX2BGR10ui1;
  3310. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3311. fglInternalFormat := GL_RGB10;
  3312. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3313. {$ELSE}
  3314. fOpenGLFormat := tfRGB16us3;
  3315. {$ENDIF}
  3316. end;
  3317. procedure TfdBGR16us3.SetValues;
  3318. begin
  3319. inherited SetValues;
  3320. fBitsPerPixel := 48;
  3321. fFormat := tfBGR16us3;
  3322. fWithAlpha := tfBGRA16us4;
  3323. fWithoutAlpha := tfBGR16us3;
  3324. fRGBInverted := tfRGB16us3;
  3325. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  3326. fShift := glBitmapRec4ub(32, 16, 0, 0);
  3327. {$IFNDEF OPENGL_ES}
  3328. fOpenGLFormat := tfBGR16us3;
  3329. fglFormat := GL_BGR;
  3330. fglInternalFormat := GL_RGB16;
  3331. fglDataFormat := GL_UNSIGNED_SHORT;
  3332. {$ELSE}
  3333. fOpenGLFormat := tfRGB16us3;
  3334. {$ENDIF}
  3335. end;
  3336. procedure TfdBGRA4us1.SetValues;
  3337. begin
  3338. inherited SetValues;
  3339. fBitsPerPixel := 16;
  3340. fFormat := tfBGRA4us1;
  3341. fWithAlpha := tfBGRA4us1;
  3342. fWithoutAlpha := tfBGRX4us1;
  3343. fRGBInverted := tfRGBA4us1;
  3344. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3345. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  3346. {$IFNDEF OPENGL_ES}
  3347. fOpenGLFormat := tfBGRA4us1;
  3348. fglFormat := GL_BGRA;
  3349. fglInternalFormat := GL_RGBA4;
  3350. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3351. {$ELSE}
  3352. fOpenGLFormat := tfRGBA4us1;
  3353. {$ENDIF}
  3354. end;
  3355. procedure TfdABGR4us1.SetValues;
  3356. begin
  3357. inherited SetValues;
  3358. fBitsPerPixel := 16;
  3359. fFormat := tfABGR4us1;
  3360. fWithAlpha := tfABGR4us1;
  3361. fWithoutAlpha := tfXBGR4us1;
  3362. fRGBInverted := tfARGB4us1;
  3363. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3364. fShift := glBitmapRec4ub( 0, 4, 8, 12);
  3365. {$IFNDEF OPENGL_ES}
  3366. fOpenGLFormat := tfABGR4us1;
  3367. fglFormat := GL_RGBA;
  3368. fglInternalFormat := GL_RGBA4;
  3369. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3370. {$ELSE}
  3371. fOpenGLFormat := tfRGBA4us1;
  3372. {$ENDIF}
  3373. end;
  3374. procedure TfdBGR5A1us1.SetValues;
  3375. begin
  3376. inherited SetValues;
  3377. fBitsPerPixel := 16;
  3378. fFormat := tfBGR5A1us1;
  3379. fWithAlpha := tfBGR5A1us1;
  3380. fWithoutAlpha := tfBGR5X1us1;
  3381. fRGBInverted := tfRGB5A1us1;
  3382. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3383. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  3384. {$IFNDEF OPENGL_ES}
  3385. fOpenGLFormat := tfBGR5A1us1;
  3386. fglFormat := GL_BGRA;
  3387. fglInternalFormat := GL_RGB5_A1;
  3388. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3389. {$ELSE}
  3390. fOpenGLFormat := tfRGB5A1us1;
  3391. {$ENDIF}
  3392. end;
  3393. procedure TfdA1BGR5us1.SetValues;
  3394. begin
  3395. inherited SetValues;
  3396. fBitsPerPixel := 16;
  3397. fFormat := tfA1BGR5us1;
  3398. fWithAlpha := tfA1BGR5us1;
  3399. fWithoutAlpha := tfX1BGR5us1;
  3400. fRGBInverted := tfA1RGB5us1;
  3401. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3402. fShift := glBitmapRec4ub( 0, 5, 10, 15);
  3403. {$IFNDEF OPENGL_ES}
  3404. fOpenGLFormat := tfA1BGR5us1;
  3405. fglFormat := GL_RGBA;
  3406. fglInternalFormat := GL_RGB5_A1;
  3407. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3408. {$ELSE}
  3409. fOpenGLFormat := tfRGB5A1us1;
  3410. {$ENDIF}
  3411. end;
  3412. procedure TfdBGRA8ui1.SetValues;
  3413. begin
  3414. inherited SetValues;
  3415. fBitsPerPixel := 32;
  3416. fFormat := tfBGRA8ui1;
  3417. fWithAlpha := tfBGRA8ui1;
  3418. fWithoutAlpha := tfBGRX8ui1;
  3419. fRGBInverted := tfRGBA8ui1;
  3420. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3421. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  3422. {$IFNDEF OPENGL_ES}
  3423. fOpenGLFormat := tfBGRA8ui1;
  3424. fglFormat := GL_BGRA;
  3425. fglInternalFormat := GL_RGBA8;
  3426. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3427. {$ELSE}
  3428. fOpenGLFormat := tfRGBA8ub4;
  3429. {$ENDIF}
  3430. end;
  3431. procedure TfdABGR8ui1.SetValues;
  3432. begin
  3433. inherited SetValues;
  3434. fBitsPerPixel := 32;
  3435. fFormat := tfABGR8ui1;
  3436. fWithAlpha := tfABGR8ui1;
  3437. fWithoutAlpha := tfXBGR8ui1;
  3438. fRGBInverted := tfARGB8ui1;
  3439. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3440. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  3441. {$IFNDEF OPENGL_ES}
  3442. fOpenGLFormat := tfABGR8ui1;
  3443. fglFormat := GL_RGBA;
  3444. fglInternalFormat := GL_RGBA8;
  3445. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3446. {$ELSE}
  3447. fOpenGLFormat := tfRGBA8ub4
  3448. {$ENDIF}
  3449. end;
  3450. procedure TfdBGRA8ub4.SetValues;
  3451. begin
  3452. inherited SetValues;
  3453. fBitsPerPixel := 32;
  3454. fFormat := tfBGRA8ub4;
  3455. fWithAlpha := tfBGRA8ub4;
  3456. fWithoutAlpha := tfBGR8ub3;
  3457. fRGBInverted := tfRGBA8ub4;
  3458. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3459. fShift := glBitmapRec4ub(16, 8, 0, 24);
  3460. {$IFNDEF OPENGL_ES}
  3461. fOpenGLFormat := tfBGRA8ub4;
  3462. fglFormat := GL_BGRA;
  3463. fglInternalFormat := GL_RGBA8;
  3464. fglDataFormat := GL_UNSIGNED_BYTE;
  3465. {$ELSE}
  3466. fOpenGLFormat := tfRGBA8ub4;
  3467. {$ENDIF}
  3468. end;
  3469. procedure TfdBGR10A2ui1.SetValues;
  3470. begin
  3471. inherited SetValues;
  3472. fBitsPerPixel := 32;
  3473. fFormat := tfBGR10A2ui1;
  3474. fWithAlpha := tfBGR10A2ui1;
  3475. fWithoutAlpha := tfBGR10X2ui1;
  3476. fRGBInverted := tfRGB10A2ui1;
  3477. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3478. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  3479. {$IFNDEF OPENGL_ES}
  3480. fOpenGLFormat := tfBGR10A2ui1;
  3481. fglFormat := GL_BGRA;
  3482. fglInternalFormat := GL_RGB10_A2;
  3483. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3484. {$ELSE}
  3485. fOpenGLFormat := tfA2RGB10ui1;
  3486. {$ENDIF}
  3487. end;
  3488. procedure TfdA2BGR10ui1.SetValues;
  3489. begin
  3490. inherited SetValues;
  3491. fBitsPerPixel := 32;
  3492. fFormat := tfA2BGR10ui1;
  3493. fWithAlpha := tfA2BGR10ui1;
  3494. fWithoutAlpha := tfX2BGR10ui1;
  3495. fRGBInverted := tfA2RGB10ui1;
  3496. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3497. fShift := glBitmapRec4ub( 0, 10, 20, 30);
  3498. {$IFNDEF OPENGL_ES}
  3499. fOpenGLFormat := tfA2BGR10ui1;
  3500. fglFormat := GL_RGBA;
  3501. fglInternalFormat := GL_RGB10_A2;
  3502. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3503. {$ELSE}
  3504. fOpenGLFormat := tfA2RGB10ui1;
  3505. {$ENDIF}
  3506. end;
  3507. procedure TfdBGRA16us4.SetValues;
  3508. begin
  3509. inherited SetValues;
  3510. fBitsPerPixel := 64;
  3511. fFormat := tfBGRA16us4;
  3512. fWithAlpha := tfBGRA16us4;
  3513. fWithoutAlpha := tfBGR16us3;
  3514. fRGBInverted := tfRGBA16us4;
  3515. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3516. fShift := glBitmapRec4ub(32, 16, 0, 48);
  3517. {$IFNDEF OPENGL_ES}
  3518. fOpenGLFormat := tfBGRA16us4;
  3519. fglFormat := GL_BGRA;
  3520. fglInternalFormat := GL_RGBA16;
  3521. fglDataFormat := GL_UNSIGNED_SHORT;
  3522. {$ELSE}
  3523. fOpenGLFormat := tfRGBA16us4;
  3524. {$ENDIF}
  3525. end;
  3526. procedure TfdDepth16us1.SetValues;
  3527. begin
  3528. inherited SetValues;
  3529. fBitsPerPixel := 16;
  3530. fFormat := tfDepth16us1;
  3531. fWithoutAlpha := tfDepth16us1;
  3532. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3533. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3534. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  3535. fOpenGLFormat := tfDepth16us1;
  3536. fglFormat := GL_DEPTH_COMPONENT;
  3537. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3538. fglDataFormat := GL_UNSIGNED_SHORT;
  3539. {$IFEND}
  3540. end;
  3541. procedure TfdDepth24ui1.SetValues;
  3542. begin
  3543. inherited SetValues;
  3544. fBitsPerPixel := 32;
  3545. fFormat := tfDepth24ui1;
  3546. fWithoutAlpha := tfDepth24ui1;
  3547. fOpenGLFormat := tfDepth24ui1;
  3548. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3549. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3550. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  3551. fOpenGLFormat := tfDepth24ui1;
  3552. fglFormat := GL_DEPTH_COMPONENT;
  3553. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3554. fglDataFormat := GL_UNSIGNED_INT;
  3555. {$IFEND}
  3556. end;
  3557. procedure TfdDepth32ui1.SetValues;
  3558. begin
  3559. inherited SetValues;
  3560. fBitsPerPixel := 32;
  3561. fFormat := tfDepth32ui1;
  3562. fWithoutAlpha := tfDepth32ui1;
  3563. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3564. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3565. {$IF NOT DEFINED(OPENGL_ES)}
  3566. fOpenGLFormat := tfDepth32ui1;
  3567. fglFormat := GL_DEPTH_COMPONENT;
  3568. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3569. fglDataFormat := GL_UNSIGNED_INT;
  3570. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  3571. fOpenGLFormat := tfDepth24ui1;
  3572. {$ELSEIF DEFINED(OPENGL_ES_2_0)}
  3573. fOpenGLFormat := tfDepth16us1;
  3574. {$IFEND}
  3575. end;
  3576. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3577. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3578. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3579. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3580. begin
  3581. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3582. end;
  3583. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3584. begin
  3585. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3586. end;
  3587. procedure TfdS3tcDtx1RGBA.SetValues;
  3588. begin
  3589. inherited SetValues;
  3590. fFormat := tfS3tcDtx1RGBA;
  3591. fWithAlpha := tfS3tcDtx1RGBA;
  3592. fUncompressed := tfRGB5A1us1;
  3593. fBitsPerPixel := 4;
  3594. fIsCompressed := true;
  3595. {$IFNDEF OPENGL_ES}
  3596. fOpenGLFormat := tfS3tcDtx1RGBA;
  3597. fglFormat := GL_COMPRESSED_RGBA;
  3598. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3599. fglDataFormat := GL_UNSIGNED_BYTE;
  3600. {$ELSE}
  3601. fOpenGLFormat := fUncompressed;
  3602. {$ENDIF}
  3603. end;
  3604. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3605. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3606. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3607. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3608. begin
  3609. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3610. end;
  3611. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3612. begin
  3613. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3614. end;
  3615. procedure TfdS3tcDtx3RGBA.SetValues;
  3616. begin
  3617. inherited SetValues;
  3618. fFormat := tfS3tcDtx3RGBA;
  3619. fWithAlpha := tfS3tcDtx3RGBA;
  3620. fUncompressed := tfRGBA8ub4;
  3621. fBitsPerPixel := 8;
  3622. fIsCompressed := true;
  3623. {$IFNDEF OPENGL_ES}
  3624. fOpenGLFormat := tfS3tcDtx3RGBA;
  3625. fglFormat := GL_COMPRESSED_RGBA;
  3626. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3627. fglDataFormat := GL_UNSIGNED_BYTE;
  3628. {$ELSE}
  3629. fOpenGLFormat := fUncompressed;
  3630. {$ENDIF}
  3631. end;
  3632. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3633. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3634. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3635. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3636. begin
  3637. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3638. end;
  3639. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3640. begin
  3641. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3642. end;
  3643. procedure TfdS3tcDtx5RGBA.SetValues;
  3644. begin
  3645. inherited SetValues;
  3646. fFormat := tfS3tcDtx3RGBA;
  3647. fWithAlpha := tfS3tcDtx3RGBA;
  3648. fUncompressed := tfRGBA8ub4;
  3649. fBitsPerPixel := 8;
  3650. fIsCompressed := true;
  3651. {$IFNDEF OPENGL_ES}
  3652. fOpenGLFormat := tfS3tcDtx3RGBA;
  3653. fglFormat := GL_COMPRESSED_RGBA;
  3654. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3655. fglDataFormat := GL_UNSIGNED_BYTE;
  3656. {$ELSE}
  3657. fOpenGLFormat := fUncompressed;
  3658. {$ENDIF}
  3659. end;
  3660. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3661. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3662. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3663. function TglBitmapFormatDescriptor.GetHasRed: Boolean;
  3664. begin
  3665. result := (fPrecision.r > 0);
  3666. end;
  3667. function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
  3668. begin
  3669. result := (fPrecision.g > 0);
  3670. end;
  3671. function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
  3672. begin
  3673. result := (fPrecision.b > 0);
  3674. end;
  3675. function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
  3676. begin
  3677. result := (fPrecision.a > 0);
  3678. end;
  3679. function TglBitmapFormatDescriptor.GetHasColor: Boolean;
  3680. begin
  3681. result := HasRed or HasGreen or HasBlue;
  3682. end;
  3683. function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
  3684. begin
  3685. result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
  3686. end;
  3687. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3688. procedure TglBitmapFormatDescriptor.SetValues;
  3689. begin
  3690. fFormat := tfEmpty;
  3691. fWithAlpha := tfEmpty;
  3692. fWithoutAlpha := tfEmpty;
  3693. fOpenGLFormat := tfEmpty;
  3694. fRGBInverted := tfEmpty;
  3695. fUncompressed := tfEmpty;
  3696. fBitsPerPixel := 0;
  3697. fIsCompressed := false;
  3698. fglFormat := 0;
  3699. fglInternalFormat := 0;
  3700. fglDataFormat := 0;
  3701. FillChar(fPrecision, 0, SizeOf(fPrecision));
  3702. FillChar(fShift, 0, SizeOf(fShift));
  3703. end;
  3704. procedure TglBitmapFormatDescriptor.CalcValues;
  3705. var
  3706. i: Integer;
  3707. begin
  3708. fBytesPerPixel := fBitsPerPixel / 8;
  3709. fChannelCount := 0;
  3710. for i := 0 to 3 do begin
  3711. if (fPrecision.arr[i] > 0) then
  3712. inc(fChannelCount);
  3713. fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
  3714. fMask.arr[i] := fRange.arr[i] shl fShift.arr[i];
  3715. end;
  3716. end;
  3717. constructor TglBitmapFormatDescriptor.Create;
  3718. begin
  3719. inherited Create;
  3720. SetValues;
  3721. CalcValues;
  3722. end;
  3723. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3724. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3725. var
  3726. f: TglBitmapFormat;
  3727. begin
  3728. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3729. result := TFormatDescriptor.Get(f);
  3730. if (result.glInternalFormat = aInternalFormat) then
  3731. exit;
  3732. end;
  3733. result := TFormatDescriptor.Get(tfEmpty);
  3734. end;
  3735. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3736. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3737. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3738. class procedure TFormatDescriptor.Init;
  3739. begin
  3740. if not Assigned(FormatDescriptorCS) then
  3741. FormatDescriptorCS := TCriticalSection.Create;
  3742. end;
  3743. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3744. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3745. begin
  3746. FormatDescriptorCS.Enter;
  3747. try
  3748. result := FormatDescriptors[aFormat];
  3749. if not Assigned(result) then begin
  3750. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3751. FormatDescriptors[aFormat] := result;
  3752. end;
  3753. finally
  3754. FormatDescriptorCS.Leave;
  3755. end;
  3756. end;
  3757. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3758. class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3759. begin
  3760. result := Get(Get(aFormat).WithAlpha);
  3761. end;
  3762. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3763. class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
  3764. var
  3765. ft: TglBitmapFormat;
  3766. begin
  3767. // find matching format with OpenGL support
  3768. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3769. result := Get(ft);
  3770. if (result.MaskMatch(aMask)) and
  3771. (result.glFormat <> 0) and
  3772. (result.glInternalFormat <> 0) and
  3773. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3774. then
  3775. exit;
  3776. end;
  3777. // find matching format without OpenGL Support
  3778. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3779. result := Get(ft);
  3780. if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3781. exit;
  3782. end;
  3783. result := TFormatDescriptor.Get(tfEmpty);
  3784. end;
  3785. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3786. class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  3787. var
  3788. ft: TglBitmapFormat;
  3789. begin
  3790. // find matching format with OpenGL support
  3791. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3792. result := Get(ft);
  3793. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3794. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3795. (result.glFormat <> 0) and
  3796. (result.glInternalFormat <> 0) and
  3797. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3798. then
  3799. exit;
  3800. end;
  3801. // find matching format without OpenGL Support
  3802. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3803. result := Get(ft);
  3804. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3805. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3806. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3807. exit;
  3808. end;
  3809. result := TFormatDescriptor.Get(tfEmpty);
  3810. end;
  3811. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3812. class procedure TFormatDescriptor.Clear;
  3813. var
  3814. f: TglBitmapFormat;
  3815. begin
  3816. FormatDescriptorCS.Enter;
  3817. try
  3818. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3819. FreeAndNil(FormatDescriptors[f]);
  3820. finally
  3821. FormatDescriptorCS.Leave;
  3822. end;
  3823. end;
  3824. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3825. class procedure TFormatDescriptor.Finalize;
  3826. begin
  3827. Clear;
  3828. FreeAndNil(FormatDescriptorCS);
  3829. end;
  3830. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3831. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3832. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3833. procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
  3834. var
  3835. i: Integer;
  3836. begin
  3837. for i := 0 to 3 do begin
  3838. fShift.arr[i] := 0;
  3839. while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin
  3840. aMask.arr[i] := aMask.arr[i] shr 1;
  3841. inc(fShift.arr[i]);
  3842. end;
  3843. fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
  3844. end;
  3845. CalcValues;
  3846. end;
  3847. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3848. procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3849. begin
  3850. fBitsPerPixel := aBBP;
  3851. fPrecision := aPrec;
  3852. fShift := aShift;
  3853. CalcValues;
  3854. end;
  3855. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3856. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3857. var
  3858. data: QWord;
  3859. begin
  3860. data :=
  3861. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3862. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3863. ((aPixel.Data.b and Range.b) shl Shift.b) or
  3864. ((aPixel.Data.a and Range.a) shl Shift.a);
  3865. case BitsPerPixel of
  3866. 8: aData^ := data;
  3867. 16: PWord(aData)^ := data;
  3868. 32: PCardinal(aData)^ := data;
  3869. 64: PQWord(aData)^ := data;
  3870. else
  3871. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3872. end;
  3873. inc(aData, Round(BytesPerPixel));
  3874. end;
  3875. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3876. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3877. var
  3878. data: QWord;
  3879. i: Integer;
  3880. begin
  3881. case BitsPerPixel of
  3882. 8: data := aData^;
  3883. 16: data := PWord(aData)^;
  3884. 32: data := PCardinal(aData)^;
  3885. 64: data := PQWord(aData)^;
  3886. else
  3887. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3888. end;
  3889. for i := 0 to 3 do
  3890. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
  3891. inc(aData, Round(BytesPerPixel));
  3892. end;
  3893. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3894. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3895. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3896. procedure TbmpColorTableFormat.SetValues;
  3897. begin
  3898. inherited SetValues;
  3899. fShift := glBitmapRec4ub(8, 8, 8, 0);
  3900. end;
  3901. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3902. procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3903. begin
  3904. fFormat := aFormat;
  3905. fBitsPerPixel := aBPP;
  3906. fPrecision := aPrec;
  3907. fShift := aShift;
  3908. CalcValues;
  3909. end;
  3910. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3911. procedure TbmpColorTableFormat.CalcValues;
  3912. begin
  3913. inherited CalcValues;
  3914. end;
  3915. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3916. procedure TbmpColorTableFormat.CreateColorTable;
  3917. var
  3918. i: Integer;
  3919. begin
  3920. SetLength(fColorTable, 256);
  3921. if not HasColor then begin
  3922. // alpha
  3923. for i := 0 to High(fColorTable) do begin
  3924. fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3925. fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3926. fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3927. fColorTable[i].a := 0;
  3928. end;
  3929. end else begin
  3930. // normal
  3931. for i := 0 to High(fColorTable) do begin
  3932. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3933. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3934. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3935. fColorTable[i].a := 0;
  3936. end;
  3937. end;
  3938. end;
  3939. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3940. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3941. begin
  3942. if (BitsPerPixel <> 8) then
  3943. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3944. if not HasColor then
  3945. // alpha
  3946. aData^ := aPixel.Data.a
  3947. else
  3948. // normal
  3949. aData^ := Round(
  3950. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3951. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3952. ((aPixel.Data.b and Range.b) shl Shift.b));
  3953. inc(aData);
  3954. end;
  3955. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3956. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3957. begin
  3958. if (BitsPerPixel <> 8) then
  3959. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3960. with fColorTable[aData^] do begin
  3961. aPixel.Data.r := r;
  3962. aPixel.Data.g := g;
  3963. aPixel.Data.b := b;
  3964. aPixel.Data.a := a;
  3965. end;
  3966. inc(aData, 1);
  3967. end;
  3968. destructor TbmpColorTableFormat.Destroy;
  3969. begin
  3970. SetLength(fColorTable, 0);
  3971. inherited Destroy;
  3972. end;
  3973. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3974. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3976. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3977. var
  3978. i: Integer;
  3979. begin
  3980. for i := 0 to 3 do begin
  3981. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3982. if (aSourceFD.Range.arr[i] > 0) then
  3983. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3984. else
  3985. aPixel.Data.arr[i] := 0;
  3986. end;
  3987. end;
  3988. end;
  3989. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3990. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3991. begin
  3992. with aFuncRec do begin
  3993. if (Source.Range.r > 0) then
  3994. Dest.Data.r := Source.Data.r;
  3995. if (Source.Range.g > 0) then
  3996. Dest.Data.g := Source.Data.g;
  3997. if (Source.Range.b > 0) then
  3998. Dest.Data.b := Source.Data.b;
  3999. if (Source.Range.a > 0) then
  4000. Dest.Data.a := Source.Data.a;
  4001. end;
  4002. end;
  4003. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4004. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  4005. var
  4006. i: Integer;
  4007. begin
  4008. with aFuncRec do begin
  4009. for i := 0 to 3 do
  4010. if (Source.Range.arr[i] > 0) then
  4011. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  4012. end;
  4013. end;
  4014. type
  4015. TShiftData = packed record
  4016. case Integer of
  4017. 0: (r, g, b, a: SmallInt);
  4018. 1: (arr: array[0..3] of SmallInt);
  4019. end;
  4020. PShiftData = ^TShiftData;
  4021. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4022. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  4023. var
  4024. i: Integer;
  4025. begin
  4026. with aFuncRec do
  4027. for i := 0 to 3 do
  4028. if (Source.Range.arr[i] > 0) then
  4029. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  4030. end;
  4031. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4032. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  4033. begin
  4034. with aFuncRec do begin
  4035. Dest.Data := Source.Data;
  4036. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  4037. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  4038. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  4039. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  4040. end;
  4041. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  4042. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  4043. end;
  4044. end;
  4045. end;
  4046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4047. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  4048. var
  4049. i: Integer;
  4050. begin
  4051. with aFuncRec do begin
  4052. for i := 0 to 3 do
  4053. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  4054. end;
  4055. end;
  4056. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4057. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  4058. var
  4059. Temp: Single;
  4060. begin
  4061. with FuncRec do begin
  4062. if (FuncRec.Args = nil) then begin //source has no alpha
  4063. Temp :=
  4064. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  4065. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  4066. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  4067. Dest.Data.a := Round(Dest.Range.a * Temp);
  4068. end else
  4069. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  4070. end;
  4071. end;
  4072. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4073. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  4074. type
  4075. PglBitmapPixelData = ^TglBitmapPixelData;
  4076. begin
  4077. with FuncRec do begin
  4078. Dest.Data.r := Source.Data.r;
  4079. Dest.Data.g := Source.Data.g;
  4080. Dest.Data.b := Source.Data.b;
  4081. with PglBitmapPixelData(Args)^ do
  4082. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  4083. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  4084. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  4085. Dest.Data.a := 0
  4086. else
  4087. Dest.Data.a := Dest.Range.a;
  4088. end;
  4089. end;
  4090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4091. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  4092. begin
  4093. with FuncRec do begin
  4094. Dest.Data.r := Source.Data.r;
  4095. Dest.Data.g := Source.Data.g;
  4096. Dest.Data.b := Source.Data.b;
  4097. Dest.Data.a := PCardinal(Args)^;
  4098. end;
  4099. end;
  4100. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4101. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  4102. type
  4103. PRGBPix = ^TRGBPix;
  4104. TRGBPix = array [0..2] of byte;
  4105. var
  4106. Temp: Byte;
  4107. begin
  4108. while aWidth > 0 do begin
  4109. Temp := PRGBPix(aData)^[0];
  4110. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  4111. PRGBPix(aData)^[2] := Temp;
  4112. if aHasAlpha then
  4113. Inc(aData, 4)
  4114. else
  4115. Inc(aData, 3);
  4116. dec(aWidth);
  4117. end;
  4118. end;
  4119. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4120. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4121. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4122. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  4123. begin
  4124. result := TFormatDescriptor.Get(Format);
  4125. end;
  4126. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4127. function TglBitmap.GetWidth: Integer;
  4128. begin
  4129. if (ffX in fDimension.Fields) then
  4130. result := fDimension.X
  4131. else
  4132. result := -1;
  4133. end;
  4134. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4135. function TglBitmap.GetHeight: Integer;
  4136. begin
  4137. if (ffY in fDimension.Fields) then
  4138. result := fDimension.Y
  4139. else
  4140. result := -1;
  4141. end;
  4142. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4143. function TglBitmap.GetFileWidth: Integer;
  4144. begin
  4145. result := Max(1, Width);
  4146. end;
  4147. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4148. function TglBitmap.GetFileHeight: Integer;
  4149. begin
  4150. result := Max(1, Height);
  4151. end;
  4152. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4153. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  4154. begin
  4155. if fCustomData = aValue then
  4156. exit;
  4157. fCustomData := aValue;
  4158. end;
  4159. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4160. procedure TglBitmap.SetCustomName(const aValue: String);
  4161. begin
  4162. if fCustomName = aValue then
  4163. exit;
  4164. fCustomName := aValue;
  4165. end;
  4166. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4167. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  4168. begin
  4169. if fCustomNameW = aValue then
  4170. exit;
  4171. fCustomNameW := aValue;
  4172. end;
  4173. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4174. procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
  4175. begin
  4176. if fFreeDataOnDestroy = aValue then
  4177. exit;
  4178. fFreeDataOnDestroy := aValue;
  4179. end;
  4180. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4181. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  4182. begin
  4183. if fDeleteTextureOnFree = aValue then
  4184. exit;
  4185. fDeleteTextureOnFree := aValue;
  4186. end;
  4187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4188. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  4189. begin
  4190. if fFormat = aValue then
  4191. exit;
  4192. if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
  4193. raise EglBitmapUnsupportedFormat.Create(Format);
  4194. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  4195. end;
  4196. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4197. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  4198. begin
  4199. if fFreeDataAfterGenTexture = aValue then
  4200. exit;
  4201. fFreeDataAfterGenTexture := aValue;
  4202. end;
  4203. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4204. procedure TglBitmap.SetID(const aValue: Cardinal);
  4205. begin
  4206. if fID = aValue then
  4207. exit;
  4208. fID := aValue;
  4209. end;
  4210. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4211. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  4212. begin
  4213. if fMipMap = aValue then
  4214. exit;
  4215. fMipMap := aValue;
  4216. end;
  4217. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4218. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  4219. begin
  4220. if fTarget = aValue then
  4221. exit;
  4222. fTarget := aValue;
  4223. end;
  4224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4225. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  4226. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  4227. var
  4228. MaxAnisotropic: Integer;
  4229. {$IFEND}
  4230. begin
  4231. fAnisotropic := aValue;
  4232. if (ID > 0) then begin
  4233. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  4234. if GL_EXT_texture_filter_anisotropic then begin
  4235. if fAnisotropic > 0 then begin
  4236. Bind(false);
  4237. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  4238. if aValue > MaxAnisotropic then
  4239. fAnisotropic := MaxAnisotropic;
  4240. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  4241. end;
  4242. end else begin
  4243. fAnisotropic := 0;
  4244. end;
  4245. {$ELSE}
  4246. fAnisotropic := 0;
  4247. {$IFEND}
  4248. end;
  4249. end;
  4250. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4251. procedure TglBitmap.CreateID;
  4252. begin
  4253. if (ID <> 0) then
  4254. glDeleteTextures(1, @fID);
  4255. glGenTextures(1, @fID);
  4256. Bind(false);
  4257. end;
  4258. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4259. procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  4260. begin
  4261. // Set Up Parameters
  4262. SetWrap(fWrapS, fWrapT, fWrapR);
  4263. SetFilter(fFilterMin, fFilterMag);
  4264. SetAnisotropic(fAnisotropic);
  4265. {$IFNDEF OPENGL_ES}
  4266. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  4267. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4268. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  4269. {$ENDIF}
  4270. {$IFNDEF OPENGL_ES}
  4271. // Mip Maps Generation Mode
  4272. aBuildWithGlu := false;
  4273. if (MipMap = mmMipmap) then begin
  4274. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  4275. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  4276. else
  4277. aBuildWithGlu := true;
  4278. end else if (MipMap = mmMipmapGlu) then
  4279. aBuildWithGlu := true;
  4280. {$ELSE}
  4281. if (MipMap = mmMipmap) then
  4282. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
  4283. {$ENDIF}
  4284. end;
  4285. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4286. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  4287. const aWidth: Integer; const aHeight: Integer);
  4288. var
  4289. s: Single;
  4290. begin
  4291. if (Data <> aData) then begin
  4292. if (Assigned(Data)) then
  4293. FreeMem(Data);
  4294. fData := aData;
  4295. end;
  4296. if not Assigned(fData) then begin
  4297. fPixelSize := 0;
  4298. fRowSize := 0;
  4299. end else begin
  4300. FillChar(fDimension, SizeOf(fDimension), 0);
  4301. if aWidth <> -1 then begin
  4302. fDimension.Fields := fDimension.Fields + [ffX];
  4303. fDimension.X := aWidth;
  4304. end;
  4305. if aHeight <> -1 then begin
  4306. fDimension.Fields := fDimension.Fields + [ffY];
  4307. fDimension.Y := aHeight;
  4308. end;
  4309. s := TFormatDescriptor.Get(aFormat).BytesPerPixel;
  4310. fFormat := aFormat;
  4311. fPixelSize := Ceil(s);
  4312. fRowSize := Ceil(s * aWidth);
  4313. end;
  4314. end;
  4315. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4316. function TglBitmap.FlipHorz: Boolean;
  4317. begin
  4318. result := false;
  4319. end;
  4320. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4321. function TglBitmap.FlipVert: Boolean;
  4322. begin
  4323. result := false;
  4324. end;
  4325. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4326. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4327. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4328. procedure TglBitmap.AfterConstruction;
  4329. begin
  4330. inherited AfterConstruction;
  4331. fID := 0;
  4332. fTarget := 0;
  4333. {$IFNDEF OPENGL_ES}
  4334. fIsResident := false;
  4335. {$ENDIF}
  4336. fMipMap := glBitmapDefaultMipmap;
  4337. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  4338. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  4339. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  4340. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  4341. {$IFNDEF OPENGL_ES}
  4342. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  4343. {$ENDIF}
  4344. end;
  4345. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4346. procedure TglBitmap.BeforeDestruction;
  4347. var
  4348. NewData: PByte;
  4349. begin
  4350. if fFreeDataOnDestroy then begin
  4351. NewData := nil;
  4352. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  4353. end;
  4354. if (fID > 0) and fDeleteTextureOnFree then
  4355. glDeleteTextures(1, @fID);
  4356. inherited BeforeDestruction;
  4357. end;
  4358. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4359. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  4360. var
  4361. TempPos: Integer;
  4362. begin
  4363. if not Assigned(aResType) then begin
  4364. TempPos := Pos('.', aResource);
  4365. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  4366. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  4367. end;
  4368. end;
  4369. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4370. procedure TglBitmap.LoadFromFile(const aFilename: String);
  4371. var
  4372. fs: TFileStream;
  4373. begin
  4374. if not FileExists(aFilename) then
  4375. raise EglBitmap.Create('file does not exist: ' + aFilename);
  4376. fFilename := aFilename;
  4377. fs := TFileStream.Create(fFilename, fmOpenRead);
  4378. try
  4379. fs.Position := 0;
  4380. LoadFromStream(fs);
  4381. finally
  4382. fs.Free;
  4383. end;
  4384. end;
  4385. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4386. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  4387. begin
  4388. {$IFDEF GLB_SUPPORT_PNG_READ}
  4389. if not LoadPNG(aStream) then
  4390. {$ENDIF}
  4391. {$IFDEF GLB_SUPPORT_JPEG_READ}
  4392. if not LoadJPEG(aStream) then
  4393. {$ENDIF}
  4394. if not LoadDDS(aStream) then
  4395. if not LoadTGA(aStream) then
  4396. if not LoadBMP(aStream) then
  4397. if not LoadRAW(aStream) then
  4398. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  4399. end;
  4400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4401. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  4402. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  4403. var
  4404. tmpData: PByte;
  4405. size: Integer;
  4406. begin
  4407. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4408. GetMem(tmpData, size);
  4409. try
  4410. FillChar(tmpData^, size, #$FF);
  4411. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4412. except
  4413. if Assigned(tmpData) then
  4414. FreeMem(tmpData);
  4415. raise;
  4416. end;
  4417. AddFunc(Self, aFunc, false, aFormat, aArgs);
  4418. end;
  4419. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4420. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  4421. var
  4422. rs: TResourceStream;
  4423. begin
  4424. PrepareResType(aResource, aResType);
  4425. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4426. try
  4427. LoadFromStream(rs);
  4428. finally
  4429. rs.Free;
  4430. end;
  4431. end;
  4432. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4433. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4434. var
  4435. rs: TResourceStream;
  4436. begin
  4437. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4438. try
  4439. LoadFromStream(rs);
  4440. finally
  4441. rs.Free;
  4442. end;
  4443. end;
  4444. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4445. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  4446. var
  4447. fs: TFileStream;
  4448. begin
  4449. fs := TFileStream.Create(aFileName, fmCreate);
  4450. try
  4451. fs.Position := 0;
  4452. SaveToStream(fs, aFileType);
  4453. finally
  4454. fs.Free;
  4455. end;
  4456. end;
  4457. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4458. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  4459. begin
  4460. case aFileType of
  4461. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4462. ftPNG: SavePNG(aStream);
  4463. {$ENDIF}
  4464. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  4465. ftJPEG: SaveJPEG(aStream);
  4466. {$ENDIF}
  4467. ftDDS: SaveDDS(aStream);
  4468. ftTGA: SaveTGA(aStream);
  4469. ftBMP: SaveBMP(aStream);
  4470. ftRAW: SaveRAW(aStream);
  4471. end;
  4472. end;
  4473. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4474. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  4475. begin
  4476. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  4477. end;
  4478. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4479. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  4480. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  4481. var
  4482. DestData, TmpData, SourceData: pByte;
  4483. TempHeight, TempWidth: Integer;
  4484. SourceFD, DestFD: TFormatDescriptor;
  4485. SourceMD, DestMD: Pointer;
  4486. FuncRec: TglBitmapFunctionRec;
  4487. begin
  4488. Assert(Assigned(Data));
  4489. Assert(Assigned(aSource));
  4490. Assert(Assigned(aSource.Data));
  4491. result := false;
  4492. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  4493. SourceFD := TFormatDescriptor.Get(aSource.Format);
  4494. DestFD := TFormatDescriptor.Get(aFormat);
  4495. if (SourceFD.IsCompressed) then
  4496. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  4497. if (DestFD.IsCompressed) then
  4498. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  4499. // inkompatible Formats so CreateTemp
  4500. if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
  4501. aCreateTemp := true;
  4502. // Values
  4503. TempHeight := Max(1, aSource.Height);
  4504. TempWidth := Max(1, aSource.Width);
  4505. FuncRec.Sender := Self;
  4506. FuncRec.Args := aArgs;
  4507. TmpData := nil;
  4508. if aCreateTemp then begin
  4509. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  4510. DestData := TmpData;
  4511. end else
  4512. DestData := Data;
  4513. try
  4514. SourceFD.PreparePixel(FuncRec.Source);
  4515. DestFD.PreparePixel (FuncRec.Dest);
  4516. SourceMD := SourceFD.CreateMappingData;
  4517. DestMD := DestFD.CreateMappingData;
  4518. FuncRec.Size := aSource.Dimension;
  4519. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4520. try
  4521. SourceData := aSource.Data;
  4522. FuncRec.Position.Y := 0;
  4523. while FuncRec.Position.Y < TempHeight do begin
  4524. FuncRec.Position.X := 0;
  4525. while FuncRec.Position.X < TempWidth do begin
  4526. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4527. aFunc(FuncRec);
  4528. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  4529. inc(FuncRec.Position.X);
  4530. end;
  4531. inc(FuncRec.Position.Y);
  4532. end;
  4533. // Updating Image or InternalFormat
  4534. if aCreateTemp then
  4535. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  4536. else if (aFormat <> fFormat) then
  4537. Format := aFormat;
  4538. result := true;
  4539. finally
  4540. SourceFD.FreeMappingData(SourceMD);
  4541. DestFD.FreeMappingData(DestMD);
  4542. end;
  4543. except
  4544. if aCreateTemp and Assigned(TmpData) then
  4545. FreeMem(TmpData);
  4546. raise;
  4547. end;
  4548. end;
  4549. end;
  4550. {$IFDEF GLB_SDL}
  4551. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4552. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  4553. var
  4554. Row, RowSize: Integer;
  4555. SourceData, TmpData: PByte;
  4556. TempDepth: Integer;
  4557. FormatDesc: TFormatDescriptor;
  4558. function GetRowPointer(Row: Integer): pByte;
  4559. begin
  4560. result := aSurface.pixels;
  4561. Inc(result, Row * RowSize);
  4562. end;
  4563. begin
  4564. result := false;
  4565. FormatDesc := TFormatDescriptor.Get(Format);
  4566. if FormatDesc.IsCompressed then
  4567. raise EglBitmapUnsupportedFormat.Create(Format);
  4568. if Assigned(Data) then begin
  4569. case Trunc(FormatDesc.PixelSize) of
  4570. 1: TempDepth := 8;
  4571. 2: TempDepth := 16;
  4572. 3: TempDepth := 24;
  4573. 4: TempDepth := 32;
  4574. else
  4575. raise EglBitmapUnsupportedFormat.Create(Format);
  4576. end;
  4577. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4578. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4579. SourceData := Data;
  4580. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4581. for Row := 0 to FileHeight-1 do begin
  4582. TmpData := GetRowPointer(Row);
  4583. if Assigned(TmpData) then begin
  4584. Move(SourceData^, TmpData^, RowSize);
  4585. inc(SourceData, RowSize);
  4586. end;
  4587. end;
  4588. result := true;
  4589. end;
  4590. end;
  4591. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4592. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4593. var
  4594. pSource, pData, pTempData: PByte;
  4595. Row, RowSize, TempWidth, TempHeight: Integer;
  4596. IntFormat: TglBitmapFormat;
  4597. fd: TFormatDescriptor;
  4598. Mask: TglBitmapMask;
  4599. function GetRowPointer(Row: Integer): pByte;
  4600. begin
  4601. result := aSurface^.pixels;
  4602. Inc(result, Row * RowSize);
  4603. end;
  4604. begin
  4605. result := false;
  4606. if (Assigned(aSurface)) then begin
  4607. with aSurface^.format^ do begin
  4608. Mask.r := RMask;
  4609. Mask.g := GMask;
  4610. Mask.b := BMask;
  4611. Mask.a := AMask;
  4612. IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
  4613. if (IntFormat = tfEmpty) then
  4614. raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
  4615. end;
  4616. fd := TFormatDescriptor.Get(IntFormat);
  4617. TempWidth := aSurface^.w;
  4618. TempHeight := aSurface^.h;
  4619. RowSize := fd.GetSize(TempWidth, 1);
  4620. GetMem(pData, TempHeight * RowSize);
  4621. try
  4622. pTempData := pData;
  4623. for Row := 0 to TempHeight -1 do begin
  4624. pSource := GetRowPointer(Row);
  4625. if (Assigned(pSource)) then begin
  4626. Move(pSource^, pTempData^, RowSize);
  4627. Inc(pTempData, RowSize);
  4628. end;
  4629. end;
  4630. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4631. result := true;
  4632. except
  4633. if Assigned(pData) then
  4634. FreeMem(pData);
  4635. raise;
  4636. end;
  4637. end;
  4638. end;
  4639. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4640. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4641. var
  4642. Row, Col, AlphaInterleave: Integer;
  4643. pSource, pDest: PByte;
  4644. function GetRowPointer(Row: Integer): pByte;
  4645. begin
  4646. result := aSurface.pixels;
  4647. Inc(result, Row * Width);
  4648. end;
  4649. begin
  4650. result := false;
  4651. if Assigned(Data) then begin
  4652. if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
  4653. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4654. AlphaInterleave := 0;
  4655. case Format of
  4656. tfLuminance8Alpha8ub2:
  4657. AlphaInterleave := 1;
  4658. tfBGRA8ub4, tfRGBA8ub4:
  4659. AlphaInterleave := 3;
  4660. end;
  4661. pSource := Data;
  4662. for Row := 0 to Height -1 do begin
  4663. pDest := GetRowPointer(Row);
  4664. if Assigned(pDest) then begin
  4665. for Col := 0 to Width -1 do begin
  4666. Inc(pSource, AlphaInterleave);
  4667. pDest^ := pSource^;
  4668. Inc(pDest);
  4669. Inc(pSource);
  4670. end;
  4671. end;
  4672. end;
  4673. result := true;
  4674. end;
  4675. end;
  4676. end;
  4677. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4678. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4679. var
  4680. bmp: TglBitmap2D;
  4681. begin
  4682. bmp := TglBitmap2D.Create;
  4683. try
  4684. bmp.AssignFromSurface(aSurface);
  4685. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4686. finally
  4687. bmp.Free;
  4688. end;
  4689. end;
  4690. {$ENDIF}
  4691. {$IFDEF GLB_DELPHI}
  4692. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4693. function CreateGrayPalette: HPALETTE;
  4694. var
  4695. Idx: Integer;
  4696. Pal: PLogPalette;
  4697. begin
  4698. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4699. Pal.palVersion := $300;
  4700. Pal.palNumEntries := 256;
  4701. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4702. Pal.palPalEntry[Idx].peRed := Idx;
  4703. Pal.palPalEntry[Idx].peGreen := Idx;
  4704. Pal.palPalEntry[Idx].peBlue := Idx;
  4705. Pal.palPalEntry[Idx].peFlags := 0;
  4706. end;
  4707. Result := CreatePalette(Pal^);
  4708. FreeMem(Pal);
  4709. end;
  4710. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4711. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4712. var
  4713. Row: Integer;
  4714. pSource, pData: PByte;
  4715. begin
  4716. result := false;
  4717. if Assigned(Data) then begin
  4718. if Assigned(aBitmap) then begin
  4719. aBitmap.Width := Width;
  4720. aBitmap.Height := Height;
  4721. case Format of
  4722. tfAlpha8ub1, tfLuminance8ub1: begin
  4723. aBitmap.PixelFormat := pf8bit;
  4724. aBitmap.Palette := CreateGrayPalette;
  4725. end;
  4726. tfRGB5A1us1:
  4727. aBitmap.PixelFormat := pf15bit;
  4728. tfR5G6B5us1:
  4729. aBitmap.PixelFormat := pf16bit;
  4730. tfRGB8ub3, tfBGR8ub3:
  4731. aBitmap.PixelFormat := pf24bit;
  4732. tfRGBA8ub4, tfBGRA8ub4:
  4733. aBitmap.PixelFormat := pf32bit;
  4734. else
  4735. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4736. end;
  4737. pSource := Data;
  4738. for Row := 0 to FileHeight -1 do begin
  4739. pData := aBitmap.Scanline[Row];
  4740. Move(pSource^, pData^, fRowSize);
  4741. Inc(pSource, fRowSize);
  4742. if (Format in [tfRGB8ub3, tfRGBA8ub4]) then // swap RGB(A) to BGR(A)
  4743. SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
  4744. end;
  4745. result := true;
  4746. end;
  4747. end;
  4748. end;
  4749. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4750. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4751. var
  4752. pSource, pData, pTempData: PByte;
  4753. Row, RowSize, TempWidth, TempHeight: Integer;
  4754. IntFormat: TglBitmapFormat;
  4755. begin
  4756. result := false;
  4757. if (Assigned(aBitmap)) then begin
  4758. case aBitmap.PixelFormat of
  4759. pf8bit:
  4760. IntFormat := tfLuminance8ub1;
  4761. pf15bit:
  4762. IntFormat := tfRGB5A1us1;
  4763. pf16bit:
  4764. IntFormat := tfR5G6B5us1;
  4765. pf24bit:
  4766. IntFormat := tfBGR8ub3;
  4767. pf32bit:
  4768. IntFormat := tfBGRA8ub4;
  4769. else
  4770. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4771. end;
  4772. TempWidth := aBitmap.Width;
  4773. TempHeight := aBitmap.Height;
  4774. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4775. GetMem(pData, TempHeight * RowSize);
  4776. try
  4777. pTempData := pData;
  4778. for Row := 0 to TempHeight -1 do begin
  4779. pSource := aBitmap.Scanline[Row];
  4780. if (Assigned(pSource)) then begin
  4781. Move(pSource^, pTempData^, RowSize);
  4782. Inc(pTempData, RowSize);
  4783. end;
  4784. end;
  4785. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4786. result := true;
  4787. except
  4788. if Assigned(pData) then
  4789. FreeMem(pData);
  4790. raise;
  4791. end;
  4792. end;
  4793. end;
  4794. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4795. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4796. var
  4797. Row, Col, AlphaInterleave: Integer;
  4798. pSource, pDest: PByte;
  4799. begin
  4800. result := false;
  4801. if Assigned(Data) then begin
  4802. if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
  4803. if Assigned(aBitmap) then begin
  4804. aBitmap.PixelFormat := pf8bit;
  4805. aBitmap.Palette := CreateGrayPalette;
  4806. aBitmap.Width := Width;
  4807. aBitmap.Height := Height;
  4808. case Format of
  4809. tfLuminance8Alpha8ub2:
  4810. AlphaInterleave := 1;
  4811. tfRGBA8ub4, tfBGRA8ub4:
  4812. AlphaInterleave := 3;
  4813. else
  4814. AlphaInterleave := 0;
  4815. end;
  4816. // Copy Data
  4817. pSource := Data;
  4818. for Row := 0 to Height -1 do begin
  4819. pDest := aBitmap.Scanline[Row];
  4820. if Assigned(pDest) then begin
  4821. for Col := 0 to Width -1 do begin
  4822. Inc(pSource, AlphaInterleave);
  4823. pDest^ := pSource^;
  4824. Inc(pDest);
  4825. Inc(pSource);
  4826. end;
  4827. end;
  4828. end;
  4829. result := true;
  4830. end;
  4831. end;
  4832. end;
  4833. end;
  4834. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4835. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4836. var
  4837. tex: TglBitmap2D;
  4838. begin
  4839. tex := TglBitmap2D.Create;
  4840. try
  4841. tex.AssignFromBitmap(ABitmap);
  4842. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4843. finally
  4844. tex.Free;
  4845. end;
  4846. end;
  4847. {$ENDIF}
  4848. {$IFDEF GLB_LAZARUS}
  4849. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4850. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4851. var
  4852. rid: TRawImageDescription;
  4853. FormatDesc: TFormatDescriptor;
  4854. begin
  4855. if not Assigned(Data) then
  4856. raise EglBitmap.Create('no pixel data assigned. load data before save');
  4857. result := false;
  4858. if not Assigned(aImage) or (Format = tfEmpty) then
  4859. exit;
  4860. FormatDesc := TFormatDescriptor.Get(Format);
  4861. if FormatDesc.IsCompressed then
  4862. exit;
  4863. FillChar(rid{%H-}, SizeOf(rid), 0);
  4864. if FormatDesc.IsGrayscale then
  4865. rid.Format := ricfGray
  4866. else
  4867. rid.Format := ricfRGBA;
  4868. rid.Width := Width;
  4869. rid.Height := Height;
  4870. rid.Depth := FormatDesc.BitsPerPixel;
  4871. rid.BitOrder := riboBitsInOrder;
  4872. rid.ByteOrder := riboLSBFirst;
  4873. rid.LineOrder := riloTopToBottom;
  4874. rid.LineEnd := rileTight;
  4875. rid.BitsPerPixel := FormatDesc.BitsPerPixel;
  4876. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4877. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4878. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4879. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4880. rid.RedShift := FormatDesc.Shift.r;
  4881. rid.GreenShift := FormatDesc.Shift.g;
  4882. rid.BlueShift := FormatDesc.Shift.b;
  4883. rid.AlphaShift := FormatDesc.Shift.a;
  4884. rid.MaskBitsPerPixel := 0;
  4885. rid.PaletteColorCount := 0;
  4886. aImage.DataDescription := rid;
  4887. aImage.CreateData;
  4888. if not Assigned(aImage.PixelData) then
  4889. raise EglBitmap.Create('error while creating LazIntfImage');
  4890. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4891. result := true;
  4892. end;
  4893. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4894. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4895. var
  4896. f: TglBitmapFormat;
  4897. FormatDesc: TFormatDescriptor;
  4898. ImageData: PByte;
  4899. ImageSize: Integer;
  4900. CanCopy: Boolean;
  4901. Mask: TglBitmapRec4ul;
  4902. procedure CopyConvert;
  4903. var
  4904. bfFormat: TbmpBitfieldFormat;
  4905. pSourceLine, pDestLine: PByte;
  4906. pSourceMD, pDestMD: Pointer;
  4907. Shift, Prec: TglBitmapRec4ub;
  4908. x, y: Integer;
  4909. pixel: TglBitmapPixelData;
  4910. begin
  4911. bfFormat := TbmpBitfieldFormat.Create;
  4912. with aImage.DataDescription do begin
  4913. Prec.r := RedPrec;
  4914. Prec.g := GreenPrec;
  4915. Prec.b := BluePrec;
  4916. Prec.a := AlphaPrec;
  4917. Shift.r := RedShift;
  4918. Shift.g := GreenShift;
  4919. Shift.b := BlueShift;
  4920. Shift.a := AlphaShift;
  4921. bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
  4922. end;
  4923. pSourceMD := bfFormat.CreateMappingData;
  4924. pDestMD := FormatDesc.CreateMappingData;
  4925. try
  4926. for y := 0 to aImage.Height-1 do begin
  4927. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  4928. pDestLine := ImageData + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
  4929. for x := 0 to aImage.Width-1 do begin
  4930. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  4931. FormatDesc.Map(pixel, pDestLine, pDestMD);
  4932. end;
  4933. end;
  4934. finally
  4935. FormatDesc.FreeMappingData(pDestMD);
  4936. bfFormat.FreeMappingData(pSourceMD);
  4937. bfFormat.Free;
  4938. end;
  4939. end;
  4940. begin
  4941. result := false;
  4942. if not Assigned(aImage) then
  4943. exit;
  4944. with aImage.DataDescription do begin
  4945. Mask.r := (QWord(1 shl RedPrec )-1) shl RedShift;
  4946. Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
  4947. Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
  4948. Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
  4949. end;
  4950. FormatDesc := TFormatDescriptor.GetFromMask(Mask);
  4951. f := FormatDesc.Format;
  4952. if (f = tfEmpty) then
  4953. exit;
  4954. CanCopy :=
  4955. (FormatDesc.BitsPerPixel = aImage.DataDescription.Depth) and
  4956. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  4957. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4958. ImageData := GetMem(ImageSize);
  4959. try
  4960. if CanCopy then
  4961. Move(aImage.PixelData^, ImageData^, ImageSize)
  4962. else
  4963. CopyConvert;
  4964. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4965. except
  4966. if Assigned(ImageData) then
  4967. FreeMem(ImageData);
  4968. raise;
  4969. end;
  4970. result := true;
  4971. end;
  4972. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4973. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4974. var
  4975. rid: TRawImageDescription;
  4976. FormatDesc: TFormatDescriptor;
  4977. Pixel: TglBitmapPixelData;
  4978. x, y: Integer;
  4979. srcMD: Pointer;
  4980. src, dst: PByte;
  4981. begin
  4982. result := false;
  4983. if not Assigned(aImage) or (Format = tfEmpty) then
  4984. exit;
  4985. FormatDesc := TFormatDescriptor.Get(Format);
  4986. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4987. exit;
  4988. FillChar(rid{%H-}, SizeOf(rid), 0);
  4989. rid.Format := ricfGray;
  4990. rid.Width := Width;
  4991. rid.Height := Height;
  4992. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4993. rid.BitOrder := riboBitsInOrder;
  4994. rid.ByteOrder := riboLSBFirst;
  4995. rid.LineOrder := riloTopToBottom;
  4996. rid.LineEnd := rileTight;
  4997. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4998. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4999. rid.GreenPrec := 0;
  5000. rid.BluePrec := 0;
  5001. rid.AlphaPrec := 0;
  5002. rid.RedShift := 0;
  5003. rid.GreenShift := 0;
  5004. rid.BlueShift := 0;
  5005. rid.AlphaShift := 0;
  5006. rid.MaskBitsPerPixel := 0;
  5007. rid.PaletteColorCount := 0;
  5008. aImage.DataDescription := rid;
  5009. aImage.CreateData;
  5010. srcMD := FormatDesc.CreateMappingData;
  5011. try
  5012. FormatDesc.PreparePixel(Pixel);
  5013. src := Data;
  5014. dst := aImage.PixelData;
  5015. for y := 0 to Height-1 do
  5016. for x := 0 to Width-1 do begin
  5017. FormatDesc.Unmap(src, Pixel, srcMD);
  5018. case rid.BitsPerPixel of
  5019. 8: begin
  5020. dst^ := Pixel.Data.a;
  5021. inc(dst);
  5022. end;
  5023. 16: begin
  5024. PWord(dst)^ := Pixel.Data.a;
  5025. inc(dst, 2);
  5026. end;
  5027. 24: begin
  5028. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  5029. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  5030. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  5031. inc(dst, 3);
  5032. end;
  5033. 32: begin
  5034. PCardinal(dst)^ := Pixel.Data.a;
  5035. inc(dst, 4);
  5036. end;
  5037. else
  5038. raise EglBitmapUnsupportedFormat.Create(Format);
  5039. end;
  5040. end;
  5041. finally
  5042. FormatDesc.FreeMappingData(srcMD);
  5043. end;
  5044. result := true;
  5045. end;
  5046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5047. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5048. var
  5049. tex: TglBitmap2D;
  5050. begin
  5051. tex := TglBitmap2D.Create;
  5052. try
  5053. tex.AssignFromLazIntfImage(aImage);
  5054. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  5055. finally
  5056. tex.Free;
  5057. end;
  5058. end;
  5059. {$ENDIF}
  5060. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5061. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  5062. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5063. var
  5064. rs: TResourceStream;
  5065. begin
  5066. PrepareResType(aResource, aResType);
  5067. rs := TResourceStream.Create(aInstance, aResource, aResType);
  5068. try
  5069. result := AddAlphaFromStream(rs, aFunc, aArgs);
  5070. finally
  5071. rs.Free;
  5072. end;
  5073. end;
  5074. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5075. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  5076. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5077. var
  5078. rs: TResourceStream;
  5079. begin
  5080. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  5081. try
  5082. result := AddAlphaFromStream(rs, aFunc, aArgs);
  5083. finally
  5084. rs.Free;
  5085. end;
  5086. end;
  5087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5088. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5089. begin
  5090. if TFormatDescriptor.Get(Format).IsCompressed then
  5091. raise EglBitmapUnsupportedFormat.Create(Format);
  5092. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  5093. end;
  5094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5095. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5096. var
  5097. FS: TFileStream;
  5098. begin
  5099. FS := TFileStream.Create(aFileName, fmOpenRead);
  5100. try
  5101. result := AddAlphaFromStream(FS, aFunc, aArgs);
  5102. finally
  5103. FS.Free;
  5104. end;
  5105. end;
  5106. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5107. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5108. var
  5109. tex: TglBitmap2D;
  5110. begin
  5111. tex := TglBitmap2D.Create(aStream);
  5112. try
  5113. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  5114. finally
  5115. tex.Free;
  5116. end;
  5117. end;
  5118. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5119. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5120. var
  5121. DestData, DestData2, SourceData: pByte;
  5122. TempHeight, TempWidth: Integer;
  5123. SourceFD, DestFD: TFormatDescriptor;
  5124. SourceMD, DestMD, DestMD2: Pointer;
  5125. FuncRec: TglBitmapFunctionRec;
  5126. begin
  5127. result := false;
  5128. Assert(Assigned(Data));
  5129. Assert(Assigned(aBitmap));
  5130. Assert(Assigned(aBitmap.Data));
  5131. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  5132. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  5133. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  5134. DestFD := TFormatDescriptor.Get(Format);
  5135. if not Assigned(aFunc) then begin
  5136. aFunc := glBitmapAlphaFunc;
  5137. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  5138. end else
  5139. FuncRec.Args := aArgs;
  5140. // Values
  5141. TempHeight := aBitmap.FileHeight;
  5142. TempWidth := aBitmap.FileWidth;
  5143. FuncRec.Sender := Self;
  5144. FuncRec.Size := Dimension;
  5145. FuncRec.Position.Fields := FuncRec.Size.Fields;
  5146. DestData := Data;
  5147. DestData2 := Data;
  5148. SourceData := aBitmap.Data;
  5149. // Mapping
  5150. SourceFD.PreparePixel(FuncRec.Source);
  5151. DestFD.PreparePixel (FuncRec.Dest);
  5152. SourceMD := SourceFD.CreateMappingData;
  5153. DestMD := DestFD.CreateMappingData;
  5154. DestMD2 := DestFD.CreateMappingData;
  5155. try
  5156. FuncRec.Position.Y := 0;
  5157. while FuncRec.Position.Y < TempHeight do begin
  5158. FuncRec.Position.X := 0;
  5159. while FuncRec.Position.X < TempWidth do begin
  5160. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  5161. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  5162. aFunc(FuncRec);
  5163. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  5164. inc(FuncRec.Position.X);
  5165. end;
  5166. inc(FuncRec.Position.Y);
  5167. end;
  5168. finally
  5169. SourceFD.FreeMappingData(SourceMD);
  5170. DestFD.FreeMappingData(DestMD);
  5171. DestFD.FreeMappingData(DestMD2);
  5172. end;
  5173. end;
  5174. end;
  5175. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5176. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  5177. begin
  5178. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  5179. end;
  5180. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5181. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  5182. var
  5183. PixelData: TglBitmapPixelData;
  5184. begin
  5185. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5186. result := AddAlphaFromColorKeyFloat(
  5187. aRed / PixelData.Range.r,
  5188. aGreen / PixelData.Range.g,
  5189. aBlue / PixelData.Range.b,
  5190. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  5191. end;
  5192. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5193. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  5194. var
  5195. values: array[0..2] of Single;
  5196. tmp: Cardinal;
  5197. i: Integer;
  5198. PixelData: TglBitmapPixelData;
  5199. begin
  5200. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5201. with PixelData do begin
  5202. values[0] := aRed;
  5203. values[1] := aGreen;
  5204. values[2] := aBlue;
  5205. for i := 0 to 2 do begin
  5206. tmp := Trunc(Range.arr[i] * aDeviation);
  5207. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  5208. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  5209. end;
  5210. Data.a := 0;
  5211. Range.a := 0;
  5212. end;
  5213. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  5214. end;
  5215. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5216. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  5217. begin
  5218. result := AddAlphaFromValueFloat(aAlpha / $FF);
  5219. end;
  5220. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5221. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  5222. var
  5223. PixelData: TglBitmapPixelData;
  5224. begin
  5225. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5226. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  5227. end;
  5228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5229. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  5230. var
  5231. PixelData: TglBitmapPixelData;
  5232. begin
  5233. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5234. with PixelData do
  5235. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  5236. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  5237. end;
  5238. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5239. function TglBitmap.RemoveAlpha: Boolean;
  5240. var
  5241. FormatDesc: TFormatDescriptor;
  5242. begin
  5243. result := false;
  5244. FormatDesc := TFormatDescriptor.Get(Format);
  5245. if Assigned(Data) then begin
  5246. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  5247. raise EglBitmapUnsupportedFormat.Create(Format);
  5248. result := ConvertTo(FormatDesc.WithoutAlpha);
  5249. end;
  5250. end;
  5251. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5252. function TglBitmap.Clone: TglBitmap;
  5253. var
  5254. Temp: TglBitmap;
  5255. TempPtr: PByte;
  5256. Size: Integer;
  5257. begin
  5258. result := nil;
  5259. Temp := (ClassType.Create as TglBitmap);
  5260. try
  5261. // copy texture data if assigned
  5262. if Assigned(Data) then begin
  5263. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  5264. GetMem(TempPtr, Size);
  5265. try
  5266. Move(Data^, TempPtr^, Size);
  5267. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  5268. except
  5269. if Assigned(TempPtr) then
  5270. FreeMem(TempPtr);
  5271. raise;
  5272. end;
  5273. end else begin
  5274. TempPtr := nil;
  5275. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  5276. end;
  5277. // copy properties
  5278. Temp.fID := ID;
  5279. Temp.fTarget := Target;
  5280. Temp.fFormat := Format;
  5281. Temp.fMipMap := MipMap;
  5282. Temp.fAnisotropic := Anisotropic;
  5283. Temp.fBorderColor := fBorderColor;
  5284. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  5285. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  5286. Temp.fFilterMin := fFilterMin;
  5287. Temp.fFilterMag := fFilterMag;
  5288. Temp.fWrapS := fWrapS;
  5289. Temp.fWrapT := fWrapT;
  5290. Temp.fWrapR := fWrapR;
  5291. Temp.fFilename := fFilename;
  5292. Temp.fCustomName := fCustomName;
  5293. Temp.fCustomNameW := fCustomNameW;
  5294. Temp.fCustomData := fCustomData;
  5295. result := Temp;
  5296. except
  5297. FreeAndNil(Temp);
  5298. raise;
  5299. end;
  5300. end;
  5301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5302. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  5303. var
  5304. SourceFD, DestFD: TFormatDescriptor;
  5305. SourcePD, DestPD: TglBitmapPixelData;
  5306. ShiftData: TShiftData;
  5307. function DataIsIdentical: Boolean;
  5308. begin
  5309. result := SourceFD.MaskMatch(DestFD.Mask);
  5310. end;
  5311. function CanCopyDirect: Boolean;
  5312. begin
  5313. result :=
  5314. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5315. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5316. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5317. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5318. end;
  5319. function CanShift: Boolean;
  5320. begin
  5321. result :=
  5322. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5323. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5324. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5325. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5326. end;
  5327. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  5328. begin
  5329. result := 0;
  5330. while (aSource > aDest) and (aSource > 0) do begin
  5331. inc(result);
  5332. aSource := aSource shr 1;
  5333. end;
  5334. end;
  5335. begin
  5336. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  5337. SourceFD := TFormatDescriptor.Get(Format);
  5338. DestFD := TFormatDescriptor.Get(aFormat);
  5339. if DataIsIdentical then begin
  5340. result := true;
  5341. Format := aFormat;
  5342. exit;
  5343. end;
  5344. SourceFD.PreparePixel(SourcePD);
  5345. DestFD.PreparePixel (DestPD);
  5346. if CanCopyDirect then
  5347. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  5348. else if CanShift then begin
  5349. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  5350. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  5351. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  5352. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  5353. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  5354. end else
  5355. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  5356. end else
  5357. result := true;
  5358. end;
  5359. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5360. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  5361. begin
  5362. if aUseRGB or aUseAlpha then
  5363. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  5364. ((Byte(aUseAlpha) and 1) shl 1) or
  5365. (Byte(aUseRGB) and 1) ));
  5366. end;
  5367. {$IFNDEF OPENGL_ES}
  5368. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5369. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  5370. begin
  5371. fBorderColor[0] := aRed;
  5372. fBorderColor[1] := aGreen;
  5373. fBorderColor[2] := aBlue;
  5374. fBorderColor[3] := aAlpha;
  5375. if (ID > 0) then begin
  5376. Bind(false);
  5377. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  5378. end;
  5379. end;
  5380. {$ENDIF}
  5381. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5382. procedure TglBitmap.FreeData;
  5383. var
  5384. TempPtr: PByte;
  5385. begin
  5386. TempPtr := nil;
  5387. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  5388. end;
  5389. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5390. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  5391. const aAlpha: Byte);
  5392. begin
  5393. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  5394. end;
  5395. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5396. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  5397. var
  5398. PixelData: TglBitmapPixelData;
  5399. begin
  5400. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5401. FillWithColorFloat(
  5402. aRed / PixelData.Range.r,
  5403. aGreen / PixelData.Range.g,
  5404. aBlue / PixelData.Range.b,
  5405. aAlpha / PixelData.Range.a);
  5406. end;
  5407. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5408. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  5409. var
  5410. PixelData: TglBitmapPixelData;
  5411. begin
  5412. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  5413. with PixelData do begin
  5414. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  5415. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  5416. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  5417. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  5418. end;
  5419. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  5420. end;
  5421. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5422. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  5423. begin
  5424. //check MIN filter
  5425. case aMin of
  5426. GL_NEAREST:
  5427. fFilterMin := GL_NEAREST;
  5428. GL_LINEAR:
  5429. fFilterMin := GL_LINEAR;
  5430. GL_NEAREST_MIPMAP_NEAREST:
  5431. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  5432. GL_LINEAR_MIPMAP_NEAREST:
  5433. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  5434. GL_NEAREST_MIPMAP_LINEAR:
  5435. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  5436. GL_LINEAR_MIPMAP_LINEAR:
  5437. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  5438. else
  5439. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  5440. end;
  5441. //check MAG filter
  5442. case aMag of
  5443. GL_NEAREST:
  5444. fFilterMag := GL_NEAREST;
  5445. GL_LINEAR:
  5446. fFilterMag := GL_LINEAR;
  5447. else
  5448. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  5449. end;
  5450. //apply filter
  5451. if (ID > 0) then begin
  5452. Bind(false);
  5453. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  5454. if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
  5455. case fFilterMin of
  5456. GL_NEAREST, GL_LINEAR:
  5457. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5458. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  5459. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  5460. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  5461. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  5462. end;
  5463. end else
  5464. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5465. end;
  5466. end;
  5467. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5468. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  5469. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  5470. begin
  5471. case aValue of
  5472. {$IFNDEF OPENGL_ES}
  5473. GL_CLAMP:
  5474. aTarget := GL_CLAMP;
  5475. {$ENDIF}
  5476. GL_REPEAT:
  5477. aTarget := GL_REPEAT;
  5478. GL_CLAMP_TO_EDGE: begin
  5479. {$IFNDEF OPENGL_ES}
  5480. if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
  5481. aTarget := GL_CLAMP
  5482. else
  5483. {$ENDIF}
  5484. aTarget := GL_CLAMP_TO_EDGE;
  5485. end;
  5486. {$IFNDEF OPENGL_ES}
  5487. GL_CLAMP_TO_BORDER: begin
  5488. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  5489. aTarget := GL_CLAMP_TO_BORDER
  5490. else
  5491. aTarget := GL_CLAMP;
  5492. end;
  5493. {$ENDIF}
  5494. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  5495. GL_MIRRORED_REPEAT: begin
  5496. {$IFNDEF OPENGL_ES}
  5497. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  5498. {$ELSE}
  5499. if GL_VERSION_2_0 then
  5500. {$ENDIF}
  5501. aTarget := GL_MIRRORED_REPEAT
  5502. else
  5503. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  5504. end;
  5505. {$IFEND}
  5506. else
  5507. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  5508. end;
  5509. end;
  5510. begin
  5511. CheckAndSetWrap(S, fWrapS);
  5512. CheckAndSetWrap(T, fWrapT);
  5513. CheckAndSetWrap(R, fWrapR);
  5514. if (ID > 0) then begin
  5515. Bind(false);
  5516. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  5517. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  5518. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  5519. {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
  5520. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  5521. {$IFEND}
  5522. end;
  5523. end;
  5524. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  5525. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5526. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  5527. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  5528. begin
  5529. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  5530. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  5531. fSwizzle[aIndex] := aValue
  5532. else
  5533. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  5534. end;
  5535. begin
  5536. {$IFNDEF OPENGL_ES}
  5537. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  5538. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  5539. {$ELSE}
  5540. if not GL_VERSION_3_0 then
  5541. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  5542. {$ENDIF}
  5543. CheckAndSetValue(r, 0);
  5544. CheckAndSetValue(g, 1);
  5545. CheckAndSetValue(b, 2);
  5546. CheckAndSetValue(a, 3);
  5547. if (ID > 0) then begin
  5548. Bind(false);
  5549. {$IFNDEF OPENGL_ES}
  5550. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  5551. {$ELSE}
  5552. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
  5553. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
  5554. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
  5555. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
  5556. {$ENDIF}
  5557. end;
  5558. end;
  5559. {$IFEND}
  5560. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5561. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  5562. begin
  5563. if aEnableTextureUnit then
  5564. glEnable(Target);
  5565. if (ID > 0) then
  5566. glBindTexture(Target, ID);
  5567. end;
  5568. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5569. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  5570. begin
  5571. if aDisableTextureUnit then
  5572. glDisable(Target);
  5573. glBindTexture(Target, 0);
  5574. end;
  5575. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5576. constructor TglBitmap.Create;
  5577. begin
  5578. if (ClassType = TglBitmap) then
  5579. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  5580. {$IFDEF GLB_NATIVE_OGL}
  5581. glbReadOpenGLExtensions;
  5582. {$ENDIF}
  5583. inherited Create;
  5584. fFormat := glBitmapGetDefaultFormat;
  5585. fFreeDataOnDestroy := true;
  5586. end;
  5587. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5588. constructor TglBitmap.Create(const aFileName: String);
  5589. begin
  5590. Create;
  5591. LoadFromFile(aFileName);
  5592. end;
  5593. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5594. constructor TglBitmap.Create(const aStream: TStream);
  5595. begin
  5596. Create;
  5597. LoadFromStream(aStream);
  5598. end;
  5599. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5600. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
  5601. var
  5602. ImageSize: Integer;
  5603. begin
  5604. Create;
  5605. if not Assigned(aData) then begin
  5606. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5607. GetMem(aData, ImageSize);
  5608. try
  5609. FillChar(aData^, ImageSize, #$FF);
  5610. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5611. except
  5612. if Assigned(aData) then
  5613. FreeMem(aData);
  5614. raise;
  5615. end;
  5616. end else begin
  5617. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5618. fFreeDataOnDestroy := false;
  5619. end;
  5620. end;
  5621. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5622. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5623. begin
  5624. Create;
  5625. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  5626. end;
  5627. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5628. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  5629. begin
  5630. Create;
  5631. LoadFromResource(aInstance, aResource, aResType);
  5632. end;
  5633. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5634. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5635. begin
  5636. Create;
  5637. LoadFromResourceID(aInstance, aResourceID, aResType);
  5638. end;
  5639. {$IFDEF GLB_SUPPORT_PNG_READ}
  5640. {$IF DEFINED(GLB_LAZ_PNG)}
  5641. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5642. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5643. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5644. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5645. const
  5646. MAGIC_LEN = 8;
  5647. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  5648. var
  5649. reader: TLazReaderPNG;
  5650. intf: TLazIntfImage;
  5651. StreamPos: Int64;
  5652. magic: String[MAGIC_LEN];
  5653. begin
  5654. result := true;
  5655. StreamPos := aStream.Position;
  5656. SetLength(magic, MAGIC_LEN);
  5657. aStream.Read(magic[1], MAGIC_LEN);
  5658. aStream.Position := StreamPos;
  5659. if (magic <> PNG_MAGIC) then begin
  5660. result := false;
  5661. exit;
  5662. end;
  5663. intf := TLazIntfImage.Create(0, 0);
  5664. reader := TLazReaderPNG.Create;
  5665. try try
  5666. reader.UpdateDescription := true;
  5667. reader.ImageRead(aStream, intf);
  5668. AssignFromLazIntfImage(intf);
  5669. except
  5670. result := false;
  5671. aStream.Position := StreamPos;
  5672. exit;
  5673. end;
  5674. finally
  5675. reader.Free;
  5676. intf.Free;
  5677. end;
  5678. end;
  5679. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5680. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5681. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5682. var
  5683. Surface: PSDL_Surface;
  5684. RWops: PSDL_RWops;
  5685. begin
  5686. result := false;
  5687. RWops := glBitmapCreateRWops(aStream);
  5688. try
  5689. if IMG_isPNG(RWops) > 0 then begin
  5690. Surface := IMG_LoadPNG_RW(RWops);
  5691. try
  5692. AssignFromSurface(Surface);
  5693. result := true;
  5694. finally
  5695. SDL_FreeSurface(Surface);
  5696. end;
  5697. end;
  5698. finally
  5699. SDL_FreeRW(RWops);
  5700. end;
  5701. end;
  5702. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5703. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5704. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5705. begin
  5706. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5707. end;
  5708. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5709. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5710. var
  5711. StreamPos: Int64;
  5712. signature: array [0..7] of byte;
  5713. png: png_structp;
  5714. png_info: png_infop;
  5715. TempHeight, TempWidth: Integer;
  5716. Format: TglBitmapFormat;
  5717. png_data: pByte;
  5718. png_rows: array of pByte;
  5719. Row, LineSize: Integer;
  5720. begin
  5721. result := false;
  5722. if not init_libPNG then
  5723. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5724. try
  5725. // signature
  5726. StreamPos := aStream.Position;
  5727. aStream.Read(signature{%H-}, 8);
  5728. aStream.Position := StreamPos;
  5729. if png_check_sig(@signature, 8) <> 0 then begin
  5730. // png read struct
  5731. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5732. if png = nil then
  5733. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5734. // png info
  5735. png_info := png_create_info_struct(png);
  5736. if png_info = nil then begin
  5737. png_destroy_read_struct(@png, nil, nil);
  5738. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5739. end;
  5740. // set read callback
  5741. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5742. // read informations
  5743. png_read_info(png, png_info);
  5744. // size
  5745. TempHeight := png_get_image_height(png, png_info);
  5746. TempWidth := png_get_image_width(png, png_info);
  5747. // format
  5748. case png_get_color_type(png, png_info) of
  5749. PNG_COLOR_TYPE_GRAY:
  5750. Format := tfLuminance8ub1;
  5751. PNG_COLOR_TYPE_GRAY_ALPHA:
  5752. Format := tfLuminance8Alpha8us1;
  5753. PNG_COLOR_TYPE_RGB:
  5754. Format := tfRGB8ub3;
  5755. PNG_COLOR_TYPE_RGB_ALPHA:
  5756. Format := tfRGBA8ub4;
  5757. else
  5758. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5759. end;
  5760. // cut upper 8 bit from 16 bit formats
  5761. if png_get_bit_depth(png, png_info) > 8 then
  5762. png_set_strip_16(png);
  5763. // expand bitdepth smaller than 8
  5764. if png_get_bit_depth(png, png_info) < 8 then
  5765. png_set_expand(png);
  5766. // allocating mem for scanlines
  5767. LineSize := png_get_rowbytes(png, png_info);
  5768. GetMem(png_data, TempHeight * LineSize);
  5769. try
  5770. SetLength(png_rows, TempHeight);
  5771. for Row := Low(png_rows) to High(png_rows) do begin
  5772. png_rows[Row] := png_data;
  5773. Inc(png_rows[Row], Row * LineSize);
  5774. end;
  5775. // read complete image into scanlines
  5776. png_read_image(png, @png_rows[0]);
  5777. // read end
  5778. png_read_end(png, png_info);
  5779. // destroy read struct
  5780. png_destroy_read_struct(@png, @png_info, nil);
  5781. SetLength(png_rows, 0);
  5782. // set new data
  5783. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5784. result := true;
  5785. except
  5786. if Assigned(png_data) then
  5787. FreeMem(png_data);
  5788. raise;
  5789. end;
  5790. end;
  5791. finally
  5792. quit_libPNG;
  5793. end;
  5794. end;
  5795. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5796. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5797. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5798. var
  5799. StreamPos: Int64;
  5800. Png: TPNGObject;
  5801. Header: String[8];
  5802. Row, Col, PixSize, LineSize: Integer;
  5803. NewImage, pSource, pDest, pAlpha: pByte;
  5804. PngFormat: TglBitmapFormat;
  5805. FormatDesc: TFormatDescriptor;
  5806. const
  5807. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5808. begin
  5809. result := false;
  5810. StreamPos := aStream.Position;
  5811. aStream.Read(Header[0], SizeOf(Header));
  5812. aStream.Position := StreamPos;
  5813. {Test if the header matches}
  5814. if Header = PngHeader then begin
  5815. Png := TPNGObject.Create;
  5816. try
  5817. Png.LoadFromStream(aStream);
  5818. case Png.Header.ColorType of
  5819. COLOR_GRAYSCALE:
  5820. PngFormat := tfLuminance8ub1;
  5821. COLOR_GRAYSCALEALPHA:
  5822. PngFormat := tfLuminance8Alpha8us1;
  5823. COLOR_RGB:
  5824. PngFormat := tfBGR8ub3;
  5825. COLOR_RGBALPHA:
  5826. PngFormat := tfBGRA8ub4;
  5827. else
  5828. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5829. end;
  5830. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5831. PixSize := Round(FormatDesc.PixelSize);
  5832. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5833. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5834. try
  5835. pDest := NewImage;
  5836. case Png.Header.ColorType of
  5837. COLOR_RGB, COLOR_GRAYSCALE:
  5838. begin
  5839. for Row := 0 to Png.Height -1 do begin
  5840. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5841. Inc(pDest, LineSize);
  5842. end;
  5843. end;
  5844. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5845. begin
  5846. PixSize := PixSize -1;
  5847. for Row := 0 to Png.Height -1 do begin
  5848. pSource := Png.Scanline[Row];
  5849. pAlpha := pByte(Png.AlphaScanline[Row]);
  5850. for Col := 0 to Png.Width -1 do begin
  5851. Move (pSource^, pDest^, PixSize);
  5852. Inc(pSource, PixSize);
  5853. Inc(pDest, PixSize);
  5854. pDest^ := pAlpha^;
  5855. inc(pAlpha);
  5856. Inc(pDest);
  5857. end;
  5858. end;
  5859. end;
  5860. else
  5861. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5862. end;
  5863. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5864. result := true;
  5865. except
  5866. if Assigned(NewImage) then
  5867. FreeMem(NewImage);
  5868. raise;
  5869. end;
  5870. finally
  5871. Png.Free;
  5872. end;
  5873. end;
  5874. end;
  5875. {$IFEND}
  5876. {$ENDIF}
  5877. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5878. {$IFDEF GLB_LIB_PNG}
  5879. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5880. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5881. begin
  5882. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5883. end;
  5884. {$ENDIF}
  5885. {$IF DEFINED(GLB_LAZ_PNG)}
  5886. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5887. procedure TglBitmap.SavePNG(const aStream: TStream);
  5888. var
  5889. png: TPortableNetworkGraphic;
  5890. intf: TLazIntfImage;
  5891. raw: TRawImage;
  5892. begin
  5893. png := TPortableNetworkGraphic.Create;
  5894. intf := TLazIntfImage.Create(0, 0);
  5895. try
  5896. if not AssignToLazIntfImage(intf) then
  5897. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5898. intf.GetRawImage(raw);
  5899. png.LoadFromRawImage(raw, false);
  5900. png.SaveToStream(aStream);
  5901. finally
  5902. png.Free;
  5903. intf.Free;
  5904. end;
  5905. end;
  5906. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5908. procedure TglBitmap.SavePNG(const aStream: TStream);
  5909. var
  5910. png: png_structp;
  5911. png_info: png_infop;
  5912. png_rows: array of pByte;
  5913. LineSize: Integer;
  5914. ColorType: Integer;
  5915. Row: Integer;
  5916. FormatDesc: TFormatDescriptor;
  5917. begin
  5918. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5919. raise EglBitmapUnsupportedFormat.Create(Format);
  5920. if not init_libPNG then
  5921. raise Exception.Create('unable to initialize libPNG.');
  5922. try
  5923. case Format of
  5924. tfAlpha8ub1, tfLuminance8ub1:
  5925. ColorType := PNG_COLOR_TYPE_GRAY;
  5926. tfLuminance8Alpha8us1:
  5927. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5928. tfBGR8ub3, tfRGB8ub3:
  5929. ColorType := PNG_COLOR_TYPE_RGB;
  5930. tfBGRA8ub4, tfRGBA8ub4:
  5931. ColorType := PNG_COLOR_TYPE_RGBA;
  5932. else
  5933. raise EglBitmapUnsupportedFormat.Create(Format);
  5934. end;
  5935. FormatDesc := TFormatDescriptor.Get(Format);
  5936. LineSize := FormatDesc.GetSize(Width, 1);
  5937. // creating array for scanline
  5938. SetLength(png_rows, Height);
  5939. try
  5940. for Row := 0 to Height - 1 do begin
  5941. png_rows[Row] := Data;
  5942. Inc(png_rows[Row], Row * LineSize)
  5943. end;
  5944. // write struct
  5945. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5946. if png = nil then
  5947. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5948. // create png info
  5949. png_info := png_create_info_struct(png);
  5950. if png_info = nil then begin
  5951. png_destroy_write_struct(@png, nil);
  5952. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5953. end;
  5954. // set read callback
  5955. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5956. // set compression
  5957. png_set_compression_level(png, 6);
  5958. if Format in [tfBGR8ub3, tfBGRA8ub4] then
  5959. png_set_bgr(png);
  5960. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5961. png_write_info(png, png_info);
  5962. png_write_image(png, @png_rows[0]);
  5963. png_write_end(png, png_info);
  5964. png_destroy_write_struct(@png, @png_info);
  5965. finally
  5966. SetLength(png_rows, 0);
  5967. end;
  5968. finally
  5969. quit_libPNG;
  5970. end;
  5971. end;
  5972. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5973. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5974. procedure TglBitmap.SavePNG(const aStream: TStream);
  5975. var
  5976. Png: TPNGObject;
  5977. pSource, pDest: pByte;
  5978. X, Y, PixSize: Integer;
  5979. ColorType: Cardinal;
  5980. Alpha: Boolean;
  5981. pTemp: pByte;
  5982. Temp: Byte;
  5983. begin
  5984. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5985. raise EglBitmapUnsupportedFormat.Create(Format);
  5986. case Format of
  5987. tfAlpha8ub1, tfLuminance8ub1: begin
  5988. ColorType := COLOR_GRAYSCALE;
  5989. PixSize := 1;
  5990. Alpha := false;
  5991. end;
  5992. tfLuminance8Alpha8us1: begin
  5993. ColorType := COLOR_GRAYSCALEALPHA;
  5994. PixSize := 1;
  5995. Alpha := true;
  5996. end;
  5997. tfBGR8ub3, tfRGB8ub3: begin
  5998. ColorType := COLOR_RGB;
  5999. PixSize := 3;
  6000. Alpha := false;
  6001. end;
  6002. tfBGRA8ub4, tfRGBA8ub4: begin
  6003. ColorType := COLOR_RGBALPHA;
  6004. PixSize := 3;
  6005. Alpha := true
  6006. end;
  6007. else
  6008. raise EglBitmapUnsupportedFormat.Create(Format);
  6009. end;
  6010. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  6011. try
  6012. // Copy ImageData
  6013. pSource := Data;
  6014. for Y := 0 to Height -1 do begin
  6015. pDest := png.ScanLine[Y];
  6016. for X := 0 to Width -1 do begin
  6017. Move(pSource^, pDest^, PixSize);
  6018. Inc(pDest, PixSize);
  6019. Inc(pSource, PixSize);
  6020. if Alpha then begin
  6021. png.AlphaScanline[Y]^[X] := pSource^;
  6022. Inc(pSource);
  6023. end;
  6024. end;
  6025. // convert RGB line to BGR
  6026. if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
  6027. pTemp := png.ScanLine[Y];
  6028. for X := 0 to Width -1 do begin
  6029. Temp := pByteArray(pTemp)^[0];
  6030. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  6031. pByteArray(pTemp)^[2] := Temp;
  6032. Inc(pTemp, 3);
  6033. end;
  6034. end;
  6035. end;
  6036. // Save to Stream
  6037. Png.CompressionLevel := 6;
  6038. Png.SaveToStream(aStream);
  6039. finally
  6040. FreeAndNil(Png);
  6041. end;
  6042. end;
  6043. {$IFEND}
  6044. {$ENDIF}
  6045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6046. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6047. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6048. {$IFDEF GLB_LIB_JPEG}
  6049. type
  6050. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  6051. glBitmap_libJPEG_source_mgr = record
  6052. pub: jpeg_source_mgr;
  6053. SrcStream: TStream;
  6054. SrcBuffer: array [1..4096] of byte;
  6055. end;
  6056. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  6057. glBitmap_libJPEG_dest_mgr = record
  6058. pub: jpeg_destination_mgr;
  6059. DestStream: TStream;
  6060. DestBuffer: array [1..4096] of byte;
  6061. end;
  6062. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  6063. begin
  6064. //DUMMY
  6065. end;
  6066. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  6067. begin
  6068. //DUMMY
  6069. end;
  6070. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  6071. begin
  6072. //DUMMY
  6073. end;
  6074. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  6075. begin
  6076. //DUMMY
  6077. end;
  6078. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  6079. begin
  6080. //DUMMY
  6081. end;
  6082. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6083. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  6084. var
  6085. src: glBitmap_libJPEG_source_mgr_ptr;
  6086. bytes: integer;
  6087. begin
  6088. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  6089. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  6090. if (bytes <= 0) then begin
  6091. src^.SrcBuffer[1] := $FF;
  6092. src^.SrcBuffer[2] := JPEG_EOI;
  6093. bytes := 2;
  6094. end;
  6095. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  6096. src^.pub.bytes_in_buffer := bytes;
  6097. result := true;
  6098. end;
  6099. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6100. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  6101. var
  6102. src: glBitmap_libJPEG_source_mgr_ptr;
  6103. begin
  6104. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  6105. if num_bytes > 0 then begin
  6106. // wanted byte isn't in buffer so set stream position and read buffer
  6107. if num_bytes > src^.pub.bytes_in_buffer then begin
  6108. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  6109. src^.pub.fill_input_buffer(cinfo);
  6110. end else begin
  6111. // wanted byte is in buffer so only skip
  6112. inc(src^.pub.next_input_byte, num_bytes);
  6113. dec(src^.pub.bytes_in_buffer, num_bytes);
  6114. end;
  6115. end;
  6116. end;
  6117. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6118. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  6119. var
  6120. dest: glBitmap_libJPEG_dest_mgr_ptr;
  6121. begin
  6122. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  6123. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  6124. // write complete buffer
  6125. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  6126. // reset buffer
  6127. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  6128. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  6129. end;
  6130. result := true;
  6131. end;
  6132. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6133. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  6134. var
  6135. Idx: Integer;
  6136. dest: glBitmap_libJPEG_dest_mgr_ptr;
  6137. begin
  6138. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  6139. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  6140. // check for endblock
  6141. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  6142. // write endblock
  6143. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  6144. // leave
  6145. break;
  6146. end else
  6147. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  6148. end;
  6149. end;
  6150. {$ENDIF}
  6151. {$IFDEF GLB_SUPPORT_JPEG_READ}
  6152. {$IF DEFINED(GLB_LAZ_JPEG)}
  6153. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6154. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6155. const
  6156. MAGIC_LEN = 2;
  6157. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  6158. var
  6159. intf: TLazIntfImage;
  6160. reader: TFPReaderJPEG;
  6161. StreamPos: Int64;
  6162. magic: String[MAGIC_LEN];
  6163. begin
  6164. result := true;
  6165. StreamPos := aStream.Position;
  6166. SetLength(magic, MAGIC_LEN);
  6167. aStream.Read(magic[1], MAGIC_LEN);
  6168. aStream.Position := StreamPos;
  6169. if (magic <> JPEG_MAGIC) then begin
  6170. result := false;
  6171. exit;
  6172. end;
  6173. reader := TFPReaderJPEG.Create;
  6174. intf := TLazIntfImage.Create(0, 0);
  6175. try try
  6176. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  6177. reader.ImageRead(aStream, intf);
  6178. AssignFromLazIntfImage(intf);
  6179. except
  6180. result := false;
  6181. aStream.Position := StreamPos;
  6182. exit;
  6183. end;
  6184. finally
  6185. reader.Free;
  6186. intf.Free;
  6187. end;
  6188. end;
  6189. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  6190. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6191. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6192. var
  6193. Surface: PSDL_Surface;
  6194. RWops: PSDL_RWops;
  6195. begin
  6196. result := false;
  6197. RWops := glBitmapCreateRWops(aStream);
  6198. try
  6199. if IMG_isJPG(RWops) > 0 then begin
  6200. Surface := IMG_LoadJPG_RW(RWops);
  6201. try
  6202. AssignFromSurface(Surface);
  6203. result := true;
  6204. finally
  6205. SDL_FreeSurface(Surface);
  6206. end;
  6207. end;
  6208. finally
  6209. SDL_FreeRW(RWops);
  6210. end;
  6211. end;
  6212. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  6213. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6214. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6215. var
  6216. StreamPos: Int64;
  6217. Temp: array[0..1]of Byte;
  6218. jpeg: jpeg_decompress_struct;
  6219. jpeg_err: jpeg_error_mgr;
  6220. IntFormat: TglBitmapFormat;
  6221. pImage: pByte;
  6222. TempHeight, TempWidth: Integer;
  6223. pTemp: pByte;
  6224. Row: Integer;
  6225. FormatDesc: TFormatDescriptor;
  6226. begin
  6227. result := false;
  6228. if not init_libJPEG then
  6229. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  6230. try
  6231. // reading first two bytes to test file and set cursor back to begin
  6232. StreamPos := aStream.Position;
  6233. aStream.Read({%H-}Temp[0], 2);
  6234. aStream.Position := StreamPos;
  6235. // if Bitmap then read file.
  6236. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  6237. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  6238. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  6239. // error managment
  6240. jpeg.err := jpeg_std_error(@jpeg_err);
  6241. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  6242. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  6243. // decompression struct
  6244. jpeg_create_decompress(@jpeg);
  6245. // allocation space for streaming methods
  6246. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  6247. // seeting up custom functions
  6248. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  6249. pub.init_source := glBitmap_libJPEG_init_source;
  6250. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  6251. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  6252. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  6253. pub.term_source := glBitmap_libJPEG_term_source;
  6254. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  6255. pub.next_input_byte := nil; // until buffer loaded
  6256. SrcStream := aStream;
  6257. end;
  6258. // set global decoding state
  6259. jpeg.global_state := DSTATE_START;
  6260. // read header of jpeg
  6261. jpeg_read_header(@jpeg, false);
  6262. // setting output parameter
  6263. case jpeg.jpeg_color_space of
  6264. JCS_GRAYSCALE:
  6265. begin
  6266. jpeg.out_color_space := JCS_GRAYSCALE;
  6267. IntFormat := tfLuminance8ub1;
  6268. end;
  6269. else
  6270. jpeg.out_color_space := JCS_RGB;
  6271. IntFormat := tfRGB8ub3;
  6272. end;
  6273. // reading image
  6274. jpeg_start_decompress(@jpeg);
  6275. TempHeight := jpeg.output_height;
  6276. TempWidth := jpeg.output_width;
  6277. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6278. // creating new image
  6279. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  6280. try
  6281. pTemp := pImage;
  6282. for Row := 0 to TempHeight -1 do begin
  6283. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  6284. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  6285. end;
  6286. // finish decompression
  6287. jpeg_finish_decompress(@jpeg);
  6288. // destroy decompression
  6289. jpeg_destroy_decompress(@jpeg);
  6290. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  6291. result := true;
  6292. except
  6293. if Assigned(pImage) then
  6294. FreeMem(pImage);
  6295. raise;
  6296. end;
  6297. end;
  6298. finally
  6299. quit_libJPEG;
  6300. end;
  6301. end;
  6302. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  6303. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6304. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6305. var
  6306. bmp: TBitmap;
  6307. jpg: TJPEGImage;
  6308. StreamPos: Int64;
  6309. Temp: array[0..1]of Byte;
  6310. begin
  6311. result := false;
  6312. // reading first two bytes to test file and set cursor back to begin
  6313. StreamPos := aStream.Position;
  6314. aStream.Read(Temp[0], 2);
  6315. aStream.Position := StreamPos;
  6316. // if Bitmap then read file.
  6317. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  6318. bmp := TBitmap.Create;
  6319. try
  6320. jpg := TJPEGImage.Create;
  6321. try
  6322. jpg.LoadFromStream(aStream);
  6323. bmp.Assign(jpg);
  6324. result := AssignFromBitmap(bmp);
  6325. finally
  6326. jpg.Free;
  6327. end;
  6328. finally
  6329. bmp.Free;
  6330. end;
  6331. end;
  6332. end;
  6333. {$IFEND}
  6334. {$ENDIF}
  6335. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  6336. {$IF DEFINED(GLB_LAZ_JPEG)}
  6337. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6338. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6339. var
  6340. jpeg: TJPEGImage;
  6341. intf: TLazIntfImage;
  6342. raw: TRawImage;
  6343. begin
  6344. jpeg := TJPEGImage.Create;
  6345. intf := TLazIntfImage.Create(0, 0);
  6346. try
  6347. if not AssignToLazIntfImage(intf) then
  6348. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  6349. intf.GetRawImage(raw);
  6350. jpeg.LoadFromRawImage(raw, false);
  6351. jpeg.SaveToStream(aStream);
  6352. finally
  6353. intf.Free;
  6354. jpeg.Free;
  6355. end;
  6356. end;
  6357. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  6358. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6359. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6360. var
  6361. jpeg: jpeg_compress_struct;
  6362. jpeg_err: jpeg_error_mgr;
  6363. Row: Integer;
  6364. pTemp, pTemp2: pByte;
  6365. procedure CopyRow(pDest, pSource: pByte);
  6366. var
  6367. X: Integer;
  6368. begin
  6369. for X := 0 to Width - 1 do begin
  6370. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  6371. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  6372. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  6373. Inc(pDest, 3);
  6374. Inc(pSource, 3);
  6375. end;
  6376. end;
  6377. begin
  6378. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6379. raise EglBitmapUnsupportedFormat.Create(Format);
  6380. if not init_libJPEG then
  6381. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  6382. try
  6383. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  6384. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  6385. // error managment
  6386. jpeg.err := jpeg_std_error(@jpeg_err);
  6387. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  6388. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  6389. // compression struct
  6390. jpeg_create_compress(@jpeg);
  6391. // allocation space for streaming methods
  6392. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  6393. // seeting up custom functions
  6394. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  6395. pub.init_destination := glBitmap_libJPEG_init_destination;
  6396. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  6397. pub.term_destination := glBitmap_libJPEG_term_destination;
  6398. pub.next_output_byte := @DestBuffer[1];
  6399. pub.free_in_buffer := Length(DestBuffer);
  6400. DestStream := aStream;
  6401. end;
  6402. // very important state
  6403. jpeg.global_state := CSTATE_START;
  6404. jpeg.image_width := Width;
  6405. jpeg.image_height := Height;
  6406. case Format of
  6407. tfAlpha8ub1, tfLuminance8ub1: begin
  6408. jpeg.input_components := 1;
  6409. jpeg.in_color_space := JCS_GRAYSCALE;
  6410. end;
  6411. tfRGB8ub3, tfBGR8ub3: begin
  6412. jpeg.input_components := 3;
  6413. jpeg.in_color_space := JCS_RGB;
  6414. end;
  6415. end;
  6416. jpeg_set_defaults(@jpeg);
  6417. jpeg_set_quality(@jpeg, 95, true);
  6418. jpeg_start_compress(@jpeg, true);
  6419. pTemp := Data;
  6420. if Format = tfBGR8ub3 then
  6421. GetMem(pTemp2, fRowSize)
  6422. else
  6423. pTemp2 := pTemp;
  6424. try
  6425. for Row := 0 to jpeg.image_height -1 do begin
  6426. // prepare row
  6427. if Format = tfBGR8ub3 then
  6428. CopyRow(pTemp2, pTemp)
  6429. else
  6430. pTemp2 := pTemp;
  6431. // write row
  6432. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  6433. inc(pTemp, fRowSize);
  6434. end;
  6435. finally
  6436. // free memory
  6437. if Format = tfBGR8ub3 then
  6438. FreeMem(pTemp2);
  6439. end;
  6440. jpeg_finish_compress(@jpeg);
  6441. jpeg_destroy_compress(@jpeg);
  6442. finally
  6443. quit_libJPEG;
  6444. end;
  6445. end;
  6446. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  6447. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6448. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6449. var
  6450. Bmp: TBitmap;
  6451. Jpg: TJPEGImage;
  6452. begin
  6453. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6454. raise EglBitmapUnsupportedFormat.Create(Format);
  6455. Bmp := TBitmap.Create;
  6456. try
  6457. Jpg := TJPEGImage.Create;
  6458. try
  6459. AssignToBitmap(Bmp);
  6460. if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
  6461. Jpg.Grayscale := true;
  6462. Jpg.PixelFormat := jf8Bit;
  6463. end;
  6464. Jpg.Assign(Bmp);
  6465. Jpg.SaveToStream(aStream);
  6466. finally
  6467. FreeAndNil(Jpg);
  6468. end;
  6469. finally
  6470. FreeAndNil(Bmp);
  6471. end;
  6472. end;
  6473. {$IFEND}
  6474. {$ENDIF}
  6475. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6476. //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6477. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6478. type
  6479. RawHeader = packed record
  6480. Magic: String[5];
  6481. Version: Byte;
  6482. Width: Integer;
  6483. Height: Integer;
  6484. DataSize: Integer;
  6485. BitsPerPixel: Integer;
  6486. Precision: TglBitmapRec4ub;
  6487. Shift: TglBitmapRec4ub;
  6488. end;
  6489. function TglBitmap.LoadRAW(const aStream: TStream): Boolean;
  6490. var
  6491. header: RawHeader;
  6492. StartPos: Int64;
  6493. fd: TFormatDescriptor;
  6494. buf: PByte;
  6495. begin
  6496. result := false;
  6497. StartPos := aStream.Position;
  6498. aStream.Read(header{%H-}, SizeOf(header));
  6499. if (header.Magic <> 'glBMP') then begin
  6500. aStream.Position := StartPos;
  6501. exit;
  6502. end;
  6503. fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
  6504. if (fd.Format = tfEmpty) then
  6505. raise EglBitmapUnsupportedFormat.Create('no supported format found');
  6506. buf := GetMemory(header.DataSize);
  6507. aStream.Read(buf^, header.DataSize);
  6508. SetDataPointer(buf, fd.Format, header.Width, header.Height);
  6509. result := true;
  6510. end;
  6511. procedure TglBitmap.SaveRAW(const aStream: TStream);
  6512. var
  6513. header: RawHeader;
  6514. fd: TFormatDescriptor;
  6515. begin
  6516. fd := TFormatDescriptor.Get(Format);
  6517. header.Magic := 'glBMP';
  6518. header.Version := 1;
  6519. header.Width := Width;
  6520. header.Height := Height;
  6521. header.DataSize := fd.GetSize(fDimension);
  6522. header.BitsPerPixel := fd.BitsPerPixel;
  6523. header.Precision := fd.Precision;
  6524. header.Shift := fd.Shift;
  6525. aStream.Write(header, SizeOf(header));
  6526. aStream.Write(Data^, header.DataSize);
  6527. end;
  6528. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6529. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6530. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6531. const
  6532. BMP_MAGIC = $4D42;
  6533. BMP_COMP_RGB = 0;
  6534. BMP_COMP_RLE8 = 1;
  6535. BMP_COMP_RLE4 = 2;
  6536. BMP_COMP_BITFIELDS = 3;
  6537. type
  6538. TBMPHeader = packed record
  6539. bfType: Word;
  6540. bfSize: Cardinal;
  6541. bfReserved1: Word;
  6542. bfReserved2: Word;
  6543. bfOffBits: Cardinal;
  6544. end;
  6545. TBMPInfo = packed record
  6546. biSize: Cardinal;
  6547. biWidth: Longint;
  6548. biHeight: Longint;
  6549. biPlanes: Word;
  6550. biBitCount: Word;
  6551. biCompression: Cardinal;
  6552. biSizeImage: Cardinal;
  6553. biXPelsPerMeter: Longint;
  6554. biYPelsPerMeter: Longint;
  6555. biClrUsed: Cardinal;
  6556. biClrImportant: Cardinal;
  6557. end;
  6558. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6559. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  6560. //////////////////////////////////////////////////////////////////////////////////////////////////
  6561. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
  6562. begin
  6563. result := tfEmpty;
  6564. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  6565. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  6566. //Read Compression
  6567. case aInfo.biCompression of
  6568. BMP_COMP_RLE4,
  6569. BMP_COMP_RLE8: begin
  6570. raise EglBitmap.Create('RLE compression is not supported');
  6571. end;
  6572. BMP_COMP_BITFIELDS: begin
  6573. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  6574. aStream.Read(aMask.r, SizeOf(aMask.r));
  6575. aStream.Read(aMask.g, SizeOf(aMask.g));
  6576. aStream.Read(aMask.b, SizeOf(aMask.b));
  6577. aStream.Read(aMask.a, SizeOf(aMask.a));
  6578. end else
  6579. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  6580. end;
  6581. end;
  6582. //get suitable format
  6583. case aInfo.biBitCount of
  6584. 8: result := tfLuminance8ub1;
  6585. 16: result := tfX1RGB5us1;
  6586. 24: result := tfBGR8ub3;
  6587. 32: result := tfXRGB8ui1;
  6588. end;
  6589. end;
  6590. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  6591. var
  6592. i, c: Integer;
  6593. ColorTable: TbmpColorTable;
  6594. begin
  6595. result := nil;
  6596. if (aInfo.biBitCount >= 16) then
  6597. exit;
  6598. aFormat := tfLuminance8ub1;
  6599. c := aInfo.biClrUsed;
  6600. if (c = 0) then
  6601. c := 1 shl aInfo.biBitCount;
  6602. SetLength(ColorTable, c);
  6603. for i := 0 to c-1 do begin
  6604. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  6605. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  6606. aFormat := tfRGB8ub3;
  6607. end;
  6608. result := TbmpColorTableFormat.Create;
  6609. result.BitsPerPixel := aInfo.biBitCount;
  6610. result.ColorTable := ColorTable;
  6611. result.CalcValues;
  6612. end;
  6613. //////////////////////////////////////////////////////////////////////////////////////////////////
  6614. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
  6615. var
  6616. FormatDesc: TFormatDescriptor;
  6617. begin
  6618. result := nil;
  6619. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  6620. FormatDesc := TFormatDescriptor.GetFromMask(aMask);
  6621. if (FormatDesc.Format = tfEmpty) then
  6622. exit;
  6623. aFormat := FormatDesc.Format;
  6624. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  6625. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  6626. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  6627. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  6628. result := TbmpBitfieldFormat.Create;
  6629. result.SetCustomValues(aInfo.biBitCount, aMask);
  6630. end;
  6631. end;
  6632. var
  6633. //simple types
  6634. StartPos: Int64;
  6635. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  6636. PaddingBuff: Cardinal;
  6637. LineBuf, ImageData, TmpData: PByte;
  6638. SourceMD, DestMD: Pointer;
  6639. BmpFormat: TglBitmapFormat;
  6640. //records
  6641. Mask: TglBitmapRec4ul;
  6642. Header: TBMPHeader;
  6643. Info: TBMPInfo;
  6644. //classes
  6645. SpecialFormat: TFormatDescriptor;
  6646. FormatDesc: TFormatDescriptor;
  6647. //////////////////////////////////////////////////////////////////////////////////////////////////
  6648. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  6649. var
  6650. i: Integer;
  6651. Pixel: TglBitmapPixelData;
  6652. begin
  6653. aStream.Read(aLineBuf^, rbLineSize);
  6654. SpecialFormat.PreparePixel(Pixel);
  6655. for i := 0 to Info.biWidth-1 do begin
  6656. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  6657. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  6658. FormatDesc.Map(Pixel, aData, DestMD);
  6659. end;
  6660. end;
  6661. begin
  6662. result := false;
  6663. BmpFormat := tfEmpty;
  6664. SpecialFormat := nil;
  6665. LineBuf := nil;
  6666. SourceMD := nil;
  6667. DestMD := nil;
  6668. // Header
  6669. StartPos := aStream.Position;
  6670. aStream.Read(Header{%H-}, SizeOf(Header));
  6671. if Header.bfType = BMP_MAGIC then begin
  6672. try try
  6673. BmpFormat := ReadInfo(Info, Mask);
  6674. SpecialFormat := ReadColorTable(BmpFormat, Info);
  6675. if not Assigned(SpecialFormat) then
  6676. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  6677. aStream.Position := StartPos + Header.bfOffBits;
  6678. if (BmpFormat <> tfEmpty) then begin
  6679. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  6680. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  6681. wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
  6682. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  6683. //get Memory
  6684. DestMD := FormatDesc.CreateMappingData;
  6685. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  6686. GetMem(ImageData, ImageSize);
  6687. if Assigned(SpecialFormat) then begin
  6688. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  6689. SourceMD := SpecialFormat.CreateMappingData;
  6690. end;
  6691. //read Data
  6692. try try
  6693. FillChar(ImageData^, ImageSize, $FF);
  6694. TmpData := ImageData;
  6695. if (Info.biHeight > 0) then
  6696. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  6697. for i := 0 to Abs(Info.biHeight)-1 do begin
  6698. if Assigned(SpecialFormat) then
  6699. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  6700. else
  6701. aStream.Read(TmpData^, wbLineSize); //else only read data
  6702. if (Info.biHeight > 0) then
  6703. dec(TmpData, wbLineSize)
  6704. else
  6705. inc(TmpData, wbLineSize);
  6706. aStream.Read(PaddingBuff{%H-}, Padding);
  6707. end;
  6708. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6709. result := true;
  6710. finally
  6711. if Assigned(LineBuf) then
  6712. FreeMem(LineBuf);
  6713. if Assigned(SourceMD) then
  6714. SpecialFormat.FreeMappingData(SourceMD);
  6715. FormatDesc.FreeMappingData(DestMD);
  6716. end;
  6717. except
  6718. if Assigned(ImageData) then
  6719. FreeMem(ImageData);
  6720. raise;
  6721. end;
  6722. end else
  6723. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6724. except
  6725. aStream.Position := StartPos;
  6726. raise;
  6727. end;
  6728. finally
  6729. FreeAndNil(SpecialFormat);
  6730. end;
  6731. end
  6732. else aStream.Position := StartPos;
  6733. end;
  6734. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6735. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6736. var
  6737. Header: TBMPHeader;
  6738. Info: TBMPInfo;
  6739. Converter: TFormatDescriptor;
  6740. FormatDesc: TFormatDescriptor;
  6741. SourceFD, DestFD: Pointer;
  6742. pData, srcData, dstData, ConvertBuffer: pByte;
  6743. Pixel: TglBitmapPixelData;
  6744. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6745. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6746. PaddingBuff: Cardinal;
  6747. function GetLineWidth : Integer;
  6748. begin
  6749. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6750. end;
  6751. begin
  6752. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6753. raise EglBitmapUnsupportedFormat.Create(Format);
  6754. Converter := nil;
  6755. FormatDesc := TFormatDescriptor.Get(Format);
  6756. ImageSize := FormatDesc.GetSize(Dimension);
  6757. FillChar(Header{%H-}, SizeOf(Header), 0);
  6758. Header.bfType := BMP_MAGIC;
  6759. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6760. Header.bfReserved1 := 0;
  6761. Header.bfReserved2 := 0;
  6762. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6763. FillChar(Info{%H-}, SizeOf(Info), 0);
  6764. Info.biSize := SizeOf(Info);
  6765. Info.biWidth := Width;
  6766. Info.biHeight := Height;
  6767. Info.biPlanes := 1;
  6768. Info.biCompression := BMP_COMP_RGB;
  6769. Info.biSizeImage := ImageSize;
  6770. try
  6771. case Format of
  6772. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
  6773. begin
  6774. Info.biBitCount := 8;
  6775. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6776. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6777. Converter := TbmpColorTableFormat.Create;
  6778. with (Converter as TbmpColorTableFormat) do begin
  6779. SetCustomValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift);
  6780. CreateColorTable;
  6781. end;
  6782. end;
  6783. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  6784. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  6785. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
  6786. begin
  6787. Info.biBitCount := 16;
  6788. Info.biCompression := BMP_COMP_BITFIELDS;
  6789. end;
  6790. tfBGR8ub3, tfRGB8ub3:
  6791. begin
  6792. Info.biBitCount := 24;
  6793. if (Format = tfRGB8ub3) then
  6794. Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6795. end;
  6796. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  6797. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
  6798. begin
  6799. Info.biBitCount := 32;
  6800. Info.biCompression := BMP_COMP_BITFIELDS;
  6801. end;
  6802. else
  6803. raise EglBitmapUnsupportedFormat.Create(Format);
  6804. end;
  6805. Info.biXPelsPerMeter := 2835;
  6806. Info.biYPelsPerMeter := 2835;
  6807. // prepare bitmasks
  6808. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6809. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6810. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6811. RedMask := FormatDesc.Mask.r;
  6812. GreenMask := FormatDesc.Mask.g;
  6813. BlueMask := FormatDesc.Mask.b;
  6814. AlphaMask := FormatDesc.Mask.a;
  6815. end;
  6816. // headers
  6817. aStream.Write(Header, SizeOf(Header));
  6818. aStream.Write(Info, SizeOf(Info));
  6819. // colortable
  6820. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6821. with (Converter as TbmpColorTableFormat) do
  6822. aStream.Write(ColorTable[0].b,
  6823. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6824. // bitmasks
  6825. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6826. aStream.Write(RedMask, SizeOf(Cardinal));
  6827. aStream.Write(GreenMask, SizeOf(Cardinal));
  6828. aStream.Write(BlueMask, SizeOf(Cardinal));
  6829. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6830. end;
  6831. // image data
  6832. rbLineSize := Round(Info.biWidth * FormatDesc.BytesPerPixel);
  6833. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6834. Padding := GetLineWidth - wbLineSize;
  6835. PaddingBuff := 0;
  6836. pData := Data;
  6837. inc(pData, (Height-1) * rbLineSize);
  6838. // prepare row buffer. But only for RGB because RGBA supports color masks
  6839. // so it's possible to change color within the image.
  6840. if Assigned(Converter) then begin
  6841. FormatDesc.PreparePixel(Pixel);
  6842. GetMem(ConvertBuffer, wbLineSize);
  6843. SourceFD := FormatDesc.CreateMappingData;
  6844. DestFD := Converter.CreateMappingData;
  6845. end else
  6846. ConvertBuffer := nil;
  6847. try
  6848. for LineIdx := 0 to Height - 1 do begin
  6849. // preparing row
  6850. if Assigned(Converter) then begin
  6851. srcData := pData;
  6852. dstData := ConvertBuffer;
  6853. for PixelIdx := 0 to Info.biWidth-1 do begin
  6854. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6855. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6856. Converter.Map(Pixel, dstData, DestFD);
  6857. end;
  6858. aStream.Write(ConvertBuffer^, wbLineSize);
  6859. end else begin
  6860. aStream.Write(pData^, rbLineSize);
  6861. end;
  6862. dec(pData, rbLineSize);
  6863. if (Padding > 0) then
  6864. aStream.Write(PaddingBuff, Padding);
  6865. end;
  6866. finally
  6867. // destroy row buffer
  6868. if Assigned(ConvertBuffer) then begin
  6869. FormatDesc.FreeMappingData(SourceFD);
  6870. Converter.FreeMappingData(DestFD);
  6871. FreeMem(ConvertBuffer);
  6872. end;
  6873. end;
  6874. finally
  6875. if Assigned(Converter) then
  6876. Converter.Free;
  6877. end;
  6878. end;
  6879. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6880. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6881. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6882. type
  6883. TTGAHeader = packed record
  6884. ImageID: Byte;
  6885. ColorMapType: Byte;
  6886. ImageType: Byte;
  6887. //ColorMapSpec: Array[0..4] of Byte;
  6888. ColorMapStart: Word;
  6889. ColorMapLength: Word;
  6890. ColorMapEntrySize: Byte;
  6891. OrigX: Word;
  6892. OrigY: Word;
  6893. Width: Word;
  6894. Height: Word;
  6895. Bpp: Byte;
  6896. ImageDesc: Byte;
  6897. end;
  6898. const
  6899. TGA_UNCOMPRESSED_RGB = 2;
  6900. TGA_UNCOMPRESSED_GRAY = 3;
  6901. TGA_COMPRESSED_RGB = 10;
  6902. TGA_COMPRESSED_GRAY = 11;
  6903. TGA_NONE_COLOR_TABLE = 0;
  6904. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6905. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6906. var
  6907. Header: TTGAHeader;
  6908. ImageData: System.PByte;
  6909. StartPosition: Int64;
  6910. PixelSize, LineSize: Integer;
  6911. tgaFormat: TglBitmapFormat;
  6912. FormatDesc: TFormatDescriptor;
  6913. Counter: packed record
  6914. X, Y: packed record
  6915. low, high, dir: Integer;
  6916. end;
  6917. end;
  6918. const
  6919. CACHE_SIZE = $4000;
  6920. ////////////////////////////////////////////////////////////////////////////////////////
  6921. procedure ReadUncompressed;
  6922. var
  6923. i, j: Integer;
  6924. buf, tmp1, tmp2: System.PByte;
  6925. begin
  6926. buf := nil;
  6927. if (Counter.X.dir < 0) then
  6928. GetMem(buf, LineSize);
  6929. try
  6930. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6931. tmp1 := ImageData;
  6932. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6933. if (Counter.X.dir < 0) then begin //flip X
  6934. aStream.Read(buf^, LineSize);
  6935. tmp2 := buf;
  6936. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6937. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6938. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6939. tmp1^ := tmp2^;
  6940. inc(tmp1);
  6941. inc(tmp2);
  6942. end;
  6943. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6944. end;
  6945. end else
  6946. aStream.Read(tmp1^, LineSize);
  6947. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6948. end;
  6949. finally
  6950. if Assigned(buf) then
  6951. FreeMem(buf);
  6952. end;
  6953. end;
  6954. ////////////////////////////////////////////////////////////////////////////////////////
  6955. procedure ReadCompressed;
  6956. /////////////////////////////////////////////////////////////////
  6957. var
  6958. TmpData: System.PByte;
  6959. LinePixelsRead: Integer;
  6960. procedure CheckLine;
  6961. begin
  6962. if (LinePixelsRead >= Header.Width) then begin
  6963. LinePixelsRead := 0;
  6964. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6965. TmpData := ImageData;
  6966. inc(TmpData, Counter.Y.low * LineSize); //set line
  6967. if (Counter.X.dir < 0) then //if x flipped then
  6968. inc(TmpData, LineSize - PixelSize); //set last pixel
  6969. end;
  6970. end;
  6971. /////////////////////////////////////////////////////////////////
  6972. var
  6973. Cache: PByte;
  6974. CacheSize, CachePos: Integer;
  6975. procedure CachedRead(out Buffer; Count: Integer);
  6976. var
  6977. BytesRead: Integer;
  6978. begin
  6979. if (CachePos + Count > CacheSize) then begin
  6980. //if buffer overflow save non read bytes
  6981. BytesRead := 0;
  6982. if (CacheSize - CachePos > 0) then begin
  6983. BytesRead := CacheSize - CachePos;
  6984. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6985. inc(CachePos, BytesRead);
  6986. end;
  6987. //load cache from file
  6988. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6989. aStream.Read(Cache^, CacheSize);
  6990. CachePos := 0;
  6991. //read rest of requested bytes
  6992. if (Count - BytesRead > 0) then begin
  6993. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6994. inc(CachePos, Count - BytesRead);
  6995. end;
  6996. end else begin
  6997. //if no buffer overflow just read the data
  6998. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6999. inc(CachePos, Count);
  7000. end;
  7001. end;
  7002. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  7003. begin
  7004. case PixelSize of
  7005. 1: begin
  7006. aBuffer^ := aData^;
  7007. inc(aBuffer, Counter.X.dir);
  7008. end;
  7009. 2: begin
  7010. PWord(aBuffer)^ := PWord(aData)^;
  7011. inc(aBuffer, 2 * Counter.X.dir);
  7012. end;
  7013. 3: begin
  7014. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  7015. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  7016. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  7017. inc(aBuffer, 3 * Counter.X.dir);
  7018. end;
  7019. 4: begin
  7020. PCardinal(aBuffer)^ := PCardinal(aData)^;
  7021. inc(aBuffer, 4 * Counter.X.dir);
  7022. end;
  7023. end;
  7024. end;
  7025. var
  7026. TotalPixelsToRead, TotalPixelsRead: Integer;
  7027. Temp: Byte;
  7028. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  7029. PixelRepeat: Boolean;
  7030. PixelsToRead, PixelCount: Integer;
  7031. begin
  7032. CacheSize := 0;
  7033. CachePos := 0;
  7034. TotalPixelsToRead := Header.Width * Header.Height;
  7035. TotalPixelsRead := 0;
  7036. LinePixelsRead := 0;
  7037. GetMem(Cache, CACHE_SIZE);
  7038. try
  7039. TmpData := ImageData;
  7040. inc(TmpData, Counter.Y.low * LineSize); //set line
  7041. if (Counter.X.dir < 0) then //if x flipped then
  7042. inc(TmpData, LineSize - PixelSize); //set last pixel
  7043. repeat
  7044. //read CommandByte
  7045. CachedRead(Temp, 1);
  7046. PixelRepeat := (Temp and $80) > 0;
  7047. PixelsToRead := (Temp and $7F) + 1;
  7048. inc(TotalPixelsRead, PixelsToRead);
  7049. if PixelRepeat then
  7050. CachedRead(buf[0], PixelSize);
  7051. while (PixelsToRead > 0) do begin
  7052. CheckLine;
  7053. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  7054. while (PixelCount > 0) do begin
  7055. if not PixelRepeat then
  7056. CachedRead(buf[0], PixelSize);
  7057. PixelToBuffer(@buf[0], TmpData);
  7058. inc(LinePixelsRead);
  7059. dec(PixelsToRead);
  7060. dec(PixelCount);
  7061. end;
  7062. end;
  7063. until (TotalPixelsRead >= TotalPixelsToRead);
  7064. finally
  7065. FreeMem(Cache);
  7066. end;
  7067. end;
  7068. function IsGrayFormat: Boolean;
  7069. begin
  7070. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  7071. end;
  7072. begin
  7073. result := false;
  7074. // reading header to test file and set cursor back to begin
  7075. StartPosition := aStream.Position;
  7076. aStream.Read(Header{%H-}, SizeOf(Header));
  7077. // no colormapped files
  7078. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  7079. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  7080. begin
  7081. try
  7082. if Header.ImageID <> 0 then // skip image ID
  7083. aStream.Position := aStream.Position + Header.ImageID;
  7084. tgaFormat := tfEmpty;
  7085. case Header.Bpp of
  7086. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  7087. 0: tgaFormat := tfLuminance8ub1;
  7088. 8: tgaFormat := tfAlpha8ub1;
  7089. end;
  7090. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  7091. 0: tgaFormat := tfLuminance16us1;
  7092. 8: tgaFormat := tfLuminance8Alpha8ub2;
  7093. end else case (Header.ImageDesc and $F) of
  7094. 0: tgaFormat := tfX1RGB5us1;
  7095. 1: tgaFormat := tfA1RGB5us1;
  7096. 4: tgaFormat := tfARGB4us1;
  7097. end;
  7098. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  7099. 0: tgaFormat := tfBGR8ub3;
  7100. end;
  7101. 32: if IsGrayFormat then case (Header.ImageDesc and $F) of
  7102. 0: tgaFormat := tfDepth32ui1;
  7103. end else case (Header.ImageDesc and $F) of
  7104. 0: tgaFormat := tfX2RGB10ui1;
  7105. 2: tgaFormat := tfA2RGB10ui1;
  7106. 8: tgaFormat := tfARGB8ui1;
  7107. end;
  7108. end;
  7109. if (tgaFormat = tfEmpty) then
  7110. raise EglBitmap.Create('LoadTga - unsupported format');
  7111. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  7112. PixelSize := FormatDesc.GetSize(1, 1);
  7113. LineSize := FormatDesc.GetSize(Header.Width, 1);
  7114. GetMem(ImageData, LineSize * Header.Height);
  7115. try
  7116. //column direction
  7117. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  7118. Counter.X.low := Header.Height-1;;
  7119. Counter.X.high := 0;
  7120. Counter.X.dir := -1;
  7121. end else begin
  7122. Counter.X.low := 0;
  7123. Counter.X.high := Header.Height-1;
  7124. Counter.X.dir := 1;
  7125. end;
  7126. // Row direction
  7127. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  7128. Counter.Y.low := 0;
  7129. Counter.Y.high := Header.Height-1;
  7130. Counter.Y.dir := 1;
  7131. end else begin
  7132. Counter.Y.low := Header.Height-1;;
  7133. Counter.Y.high := 0;
  7134. Counter.Y.dir := -1;
  7135. end;
  7136. // Read Image
  7137. case Header.ImageType of
  7138. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  7139. ReadUncompressed;
  7140. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  7141. ReadCompressed;
  7142. end;
  7143. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  7144. result := true;
  7145. except
  7146. if Assigned(ImageData) then
  7147. FreeMem(ImageData);
  7148. raise;
  7149. end;
  7150. finally
  7151. aStream.Position := StartPosition;
  7152. end;
  7153. end
  7154. else aStream.Position := StartPosition;
  7155. end;
  7156. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7157. procedure TglBitmap.SaveTGA(const aStream: TStream);
  7158. var
  7159. Header: TTGAHeader;
  7160. Size: Integer;
  7161. FormatDesc: TFormatDescriptor;
  7162. begin
  7163. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  7164. raise EglBitmapUnsupportedFormat.Create(Format);
  7165. //prepare header
  7166. FormatDesc := TFormatDescriptor.Get(Format);
  7167. FillChar(Header{%H-}, SizeOf(Header), 0);
  7168. Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
  7169. Header.Bpp := FormatDesc.BitsPerPixel;
  7170. Header.Width := Width;
  7171. Header.Height := Height;
  7172. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  7173. if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
  7174. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  7175. else
  7176. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  7177. aStream.Write(Header, SizeOf(Header));
  7178. // write Data
  7179. Size := FormatDesc.GetSize(Dimension);
  7180. aStream.Write(Data^, Size);
  7181. end;
  7182. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7183. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7184. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7185. const
  7186. DDS_MAGIC: Cardinal = $20534444;
  7187. // DDS_header.dwFlags
  7188. DDSD_CAPS = $00000001;
  7189. DDSD_HEIGHT = $00000002;
  7190. DDSD_WIDTH = $00000004;
  7191. DDSD_PIXELFORMAT = $00001000;
  7192. // DDS_header.sPixelFormat.dwFlags
  7193. DDPF_ALPHAPIXELS = $00000001;
  7194. DDPF_ALPHA = $00000002;
  7195. DDPF_FOURCC = $00000004;
  7196. DDPF_RGB = $00000040;
  7197. DDPF_LUMINANCE = $00020000;
  7198. // DDS_header.sCaps.dwCaps1
  7199. DDSCAPS_TEXTURE = $00001000;
  7200. // DDS_header.sCaps.dwCaps2
  7201. DDSCAPS2_CUBEMAP = $00000200;
  7202. D3DFMT_DXT1 = $31545844;
  7203. D3DFMT_DXT3 = $33545844;
  7204. D3DFMT_DXT5 = $35545844;
  7205. type
  7206. TDDSPixelFormat = packed record
  7207. dwSize: Cardinal;
  7208. dwFlags: Cardinal;
  7209. dwFourCC: Cardinal;
  7210. dwRGBBitCount: Cardinal;
  7211. dwRBitMask: Cardinal;
  7212. dwGBitMask: Cardinal;
  7213. dwBBitMask: Cardinal;
  7214. dwABitMask: Cardinal;
  7215. end;
  7216. TDDSCaps = packed record
  7217. dwCaps1: Cardinal;
  7218. dwCaps2: Cardinal;
  7219. dwDDSX: Cardinal;
  7220. dwReserved: Cardinal;
  7221. end;
  7222. TDDSHeader = packed record
  7223. dwSize: Cardinal;
  7224. dwFlags: Cardinal;
  7225. dwHeight: Cardinal;
  7226. dwWidth: Cardinal;
  7227. dwPitchOrLinearSize: Cardinal;
  7228. dwDepth: Cardinal;
  7229. dwMipMapCount: Cardinal;
  7230. dwReserved: array[0..10] of Cardinal;
  7231. PixelFormat: TDDSPixelFormat;
  7232. Caps: TDDSCaps;
  7233. dwReserved2: Cardinal;
  7234. end;
  7235. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7236. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  7237. var
  7238. Header: TDDSHeader;
  7239. Converter: TbmpBitfieldFormat;
  7240. function GetDDSFormat: TglBitmapFormat;
  7241. var
  7242. fd: TFormatDescriptor;
  7243. i: Integer;
  7244. Mask: TglBitmapRec4ul;
  7245. Range: TglBitmapRec4ui;
  7246. match: Boolean;
  7247. begin
  7248. result := tfEmpty;
  7249. with Header.PixelFormat do begin
  7250. // Compresses
  7251. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  7252. case Header.PixelFormat.dwFourCC of
  7253. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  7254. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  7255. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  7256. end;
  7257. end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
  7258. // prepare masks
  7259. if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
  7260. Mask.r := dwRBitMask;
  7261. Mask.g := dwGBitMask;
  7262. Mask.b := dwBBitMask;
  7263. end else begin
  7264. Mask.r := dwRBitMask;
  7265. Mask.g := dwRBitMask;
  7266. Mask.b := dwRBitMask;
  7267. end;
  7268. if (dwFlags and DDPF_ALPHAPIXELS > 0) then
  7269. Mask.a := dwABitMask
  7270. else
  7271. Mask.a := 0;;
  7272. //find matching format
  7273. fd := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
  7274. result := fd.Format;
  7275. if (result <> tfEmpty) then
  7276. exit;
  7277. //find format with same Range
  7278. for i := 0 to 3 do
  7279. Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
  7280. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  7281. fd := TFormatDescriptor.Get(result);
  7282. match := true;
  7283. for i := 0 to 3 do
  7284. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  7285. match := false;
  7286. break;
  7287. end;
  7288. if match then
  7289. break;
  7290. end;
  7291. //no format with same range found -> use default
  7292. if (result = tfEmpty) then begin
  7293. if (dwABitMask > 0) then
  7294. result := tfRGBA8ui1
  7295. else
  7296. result := tfRGB8ub3;
  7297. end;
  7298. Converter := TbmpBitfieldFormat.Create;
  7299. Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
  7300. end;
  7301. end;
  7302. end;
  7303. var
  7304. StreamPos: Int64;
  7305. x, y, LineSize, RowSize, Magic: Cardinal;
  7306. NewImage, TmpData, RowData, SrcData: System.PByte;
  7307. SourceMD, DestMD: Pointer;
  7308. Pixel: TglBitmapPixelData;
  7309. ddsFormat: TglBitmapFormat;
  7310. FormatDesc: TFormatDescriptor;
  7311. begin
  7312. result := false;
  7313. Converter := nil;
  7314. StreamPos := aStream.Position;
  7315. // Magic
  7316. aStream.Read(Magic{%H-}, sizeof(Magic));
  7317. if (Magic <> DDS_MAGIC) then begin
  7318. aStream.Position := StreamPos;
  7319. exit;
  7320. end;
  7321. //Header
  7322. aStream.Read(Header{%H-}, sizeof(Header));
  7323. if (Header.dwSize <> SizeOf(Header)) or
  7324. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  7325. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  7326. begin
  7327. aStream.Position := StreamPos;
  7328. exit;
  7329. end;
  7330. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  7331. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  7332. ddsFormat := GetDDSFormat;
  7333. try
  7334. if (ddsFormat = tfEmpty) then
  7335. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  7336. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  7337. LineSize := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
  7338. GetMem(NewImage, Header.dwHeight * LineSize);
  7339. try
  7340. TmpData := NewImage;
  7341. //Converter needed
  7342. if Assigned(Converter) then begin
  7343. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  7344. GetMem(RowData, RowSize);
  7345. SourceMD := Converter.CreateMappingData;
  7346. DestMD := FormatDesc.CreateMappingData;
  7347. try
  7348. for y := 0 to Header.dwHeight-1 do begin
  7349. TmpData := NewImage;
  7350. inc(TmpData, y * LineSize);
  7351. SrcData := RowData;
  7352. aStream.Read(SrcData^, RowSize);
  7353. for x := 0 to Header.dwWidth-1 do begin
  7354. Converter.Unmap(SrcData, Pixel, SourceMD);
  7355. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  7356. FormatDesc.Map(Pixel, TmpData, DestMD);
  7357. end;
  7358. end;
  7359. finally
  7360. Converter.FreeMappingData(SourceMD);
  7361. FormatDesc.FreeMappingData(DestMD);
  7362. FreeMem(RowData);
  7363. end;
  7364. end else
  7365. // Compressed
  7366. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  7367. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  7368. for Y := 0 to Header.dwHeight-1 do begin
  7369. aStream.Read(TmpData^, RowSize);
  7370. Inc(TmpData, LineSize);
  7371. end;
  7372. end else
  7373. // Uncompressed
  7374. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  7375. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  7376. for Y := 0 to Header.dwHeight-1 do begin
  7377. aStream.Read(TmpData^, RowSize);
  7378. Inc(TmpData, LineSize);
  7379. end;
  7380. end else
  7381. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  7382. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  7383. result := true;
  7384. except
  7385. if Assigned(NewImage) then
  7386. FreeMem(NewImage);
  7387. raise;
  7388. end;
  7389. finally
  7390. FreeAndNil(Converter);
  7391. end;
  7392. end;
  7393. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7394. procedure TglBitmap.SaveDDS(const aStream: TStream);
  7395. var
  7396. Header: TDDSHeader;
  7397. FormatDesc: TFormatDescriptor;
  7398. begin
  7399. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  7400. raise EglBitmapUnsupportedFormat.Create(Format);
  7401. FormatDesc := TFormatDescriptor.Get(Format);
  7402. // Generell
  7403. FillChar(Header{%H-}, SizeOf(Header), 0);
  7404. Header.dwSize := SizeOf(Header);
  7405. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  7406. Header.dwWidth := Max(1, Width);
  7407. Header.dwHeight := Max(1, Height);
  7408. // Caps
  7409. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  7410. // Pixelformat
  7411. Header.PixelFormat.dwSize := sizeof(Header);
  7412. if (FormatDesc.IsCompressed) then begin
  7413. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  7414. case Format of
  7415. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  7416. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  7417. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  7418. end;
  7419. end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
  7420. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  7421. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7422. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7423. end else if FormatDesc.IsGrayscale then begin
  7424. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  7425. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7426. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  7427. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7428. end else begin
  7429. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  7430. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7431. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  7432. Header.PixelFormat.dwGBitMask := FormatDesc.Mask.g;
  7433. Header.PixelFormat.dwBBitMask := FormatDesc.Mask.b;
  7434. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7435. end;
  7436. if (FormatDesc.HasAlpha) then
  7437. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  7438. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  7439. aStream.Write(Header, SizeOf(Header));
  7440. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  7441. end;
  7442. {$IFNDEF OPENGL_ES}
  7443. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7444. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7446. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7447. const aWidth: Integer; const aHeight: Integer);
  7448. var
  7449. pTemp: pByte;
  7450. Size: Integer;
  7451. begin
  7452. if (aHeight > 1) then begin
  7453. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  7454. GetMem(pTemp, Size);
  7455. try
  7456. Move(aData^, pTemp^, Size);
  7457. FreeMem(aData);
  7458. aData := nil;
  7459. except
  7460. FreeMem(pTemp);
  7461. raise;
  7462. end;
  7463. end else
  7464. pTemp := aData;
  7465. inherited SetDataPointer(pTemp, aFormat, aWidth);
  7466. end;
  7467. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7468. function TglBitmap1D.FlipHorz: Boolean;
  7469. var
  7470. Col: Integer;
  7471. pTempDest, pDest, pSource: PByte;
  7472. begin
  7473. result := inherited FlipHorz;
  7474. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  7475. pSource := Data;
  7476. GetMem(pDest, fRowSize);
  7477. try
  7478. pTempDest := pDest;
  7479. Inc(pTempDest, fRowSize);
  7480. for Col := 0 to Width-1 do begin
  7481. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  7482. Move(pSource^, pTempDest^, fPixelSize);
  7483. Inc(pSource, fPixelSize);
  7484. end;
  7485. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  7486. result := true;
  7487. except
  7488. if Assigned(pDest) then
  7489. FreeMem(pDest);
  7490. raise;
  7491. end;
  7492. end;
  7493. end;
  7494. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7495. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  7496. var
  7497. FormatDesc: TFormatDescriptor;
  7498. begin
  7499. // Upload data
  7500. FormatDesc := TFormatDescriptor.Get(Format);
  7501. if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
  7502. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7503. if FormatDesc.IsCompressed then begin
  7504. if not Assigned(glCompressedTexImage1D) then
  7505. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7506. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  7507. end else if aBuildWithGlu then
  7508. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7509. else
  7510. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7511. // Free Data
  7512. if (FreeDataAfterGenTexture) then
  7513. FreeData;
  7514. end;
  7515. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7516. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  7517. var
  7518. BuildWithGlu, TexRec: Boolean;
  7519. TexSize: Integer;
  7520. begin
  7521. if Assigned(Data) then begin
  7522. // Check Texture Size
  7523. if (aTestTextureSize) then begin
  7524. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7525. if (Width > TexSize) then
  7526. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7527. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7528. (Target = GL_TEXTURE_RECTANGLE);
  7529. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7530. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7531. end;
  7532. CreateId;
  7533. SetupParameters(BuildWithGlu);
  7534. UploadData(BuildWithGlu);
  7535. glAreTexturesResident(1, @fID, @fIsResident);
  7536. end;
  7537. end;
  7538. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7539. procedure TglBitmap1D.AfterConstruction;
  7540. begin
  7541. inherited;
  7542. Target := GL_TEXTURE_1D;
  7543. end;
  7544. {$ENDIF}
  7545. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7546. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7547. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7548. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  7549. begin
  7550. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  7551. result := fLines[aIndex]
  7552. else
  7553. result := nil;
  7554. end;
  7555. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7556. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7557. const aWidth: Integer; const aHeight: Integer);
  7558. var
  7559. Idx, LineWidth: Integer;
  7560. begin
  7561. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  7562. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  7563. // Assigning Data
  7564. if Assigned(Data) then begin
  7565. SetLength(fLines, GetHeight);
  7566. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel);
  7567. for Idx := 0 to GetHeight-1 do begin
  7568. fLines[Idx] := Data;
  7569. Inc(fLines[Idx], Idx * LineWidth);
  7570. end;
  7571. end
  7572. else SetLength(fLines, 0);
  7573. end else begin
  7574. SetLength(fLines, 0);
  7575. end;
  7576. end;
  7577. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7578. procedure TglBitmap2D.UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
  7579. var
  7580. FormatDesc: TFormatDescriptor;
  7581. begin
  7582. FormatDesc := TFormatDescriptor.Get(Format);
  7583. if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
  7584. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7585. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7586. if FormatDesc.IsCompressed then begin
  7587. if not Assigned(glCompressedTexImage2D) then
  7588. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7589. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  7590. {$IFNDEF OPENGL_ES}
  7591. end else if aBuildWithGlu then begin
  7592. gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height,
  7593. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7594. {$ENDIF}
  7595. end else begin
  7596. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  7597. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7598. end;
  7599. // Freigeben
  7600. if (FreeDataAfterGenTexture) then
  7601. FreeData;
  7602. end;
  7603. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7604. procedure TglBitmap2D.AfterConstruction;
  7605. begin
  7606. inherited;
  7607. Target := GL_TEXTURE_2D;
  7608. end;
  7609. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7610. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  7611. var
  7612. Temp: pByte;
  7613. Size, w, h: Integer;
  7614. FormatDesc: TFormatDescriptor;
  7615. begin
  7616. FormatDesc := TFormatDescriptor.Get(aFormat);
  7617. if FormatDesc.IsCompressed then
  7618. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7619. w := aRight - aLeft;
  7620. h := aBottom - aTop;
  7621. Size := FormatDesc.GetSize(w, h);
  7622. GetMem(Temp, Size);
  7623. try
  7624. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7625. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7626. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  7627. FlipVert;
  7628. except
  7629. if Assigned(Temp) then
  7630. FreeMem(Temp);
  7631. raise;
  7632. end;
  7633. end;
  7634. {$IFNDEF OPENGL_ES}
  7635. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7636. procedure TglBitmap2D.GetDataFromTexture;
  7637. var
  7638. Temp: PByte;
  7639. TempWidth, TempHeight: Integer;
  7640. TempIntFormat: GLint;
  7641. IntFormat: TglBitmapFormat;
  7642. FormatDesc: TFormatDescriptor;
  7643. begin
  7644. Bind;
  7645. // Request Data
  7646. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7647. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7648. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7649. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7650. IntFormat := FormatDesc.Format;
  7651. // Getting data from OpenGL
  7652. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7653. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7654. try
  7655. if FormatDesc.IsCompressed then begin
  7656. if not Assigned(glGetCompressedTexImage) then
  7657. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7658. glGetCompressedTexImage(Target, 0, Temp)
  7659. end else
  7660. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7661. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7662. except
  7663. if Assigned(Temp) then
  7664. FreeMem(Temp);
  7665. raise;
  7666. end;
  7667. end;
  7668. {$ENDIF}
  7669. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7670. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7671. var
  7672. {$IFNDEF OPENGL_ES}
  7673. BuildWithGlu, TexRec: Boolean;
  7674. {$ENDIF}
  7675. PotTex: Boolean;
  7676. TexSize: Integer;
  7677. begin
  7678. if Assigned(Data) then begin
  7679. // Check Texture Size
  7680. if (aTestTextureSize) then begin
  7681. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7682. if ((Height > TexSize) or (Width > TexSize)) then
  7683. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7684. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7685. {$IF NOT DEFINED(OPENGL_ES)}
  7686. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7687. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7688. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7689. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7690. if not PotTex and not GL_OES_texture_npot then
  7691. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7692. {$ELSE}
  7693. if not PotTex then
  7694. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7695. {$IFEND}
  7696. end;
  7697. CreateId;
  7698. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7699. UploadData(Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7700. {$IFNDEF OPENGL_ES}
  7701. glAreTexturesResident(1, @fID, @fIsResident);
  7702. {$ENDIF}
  7703. end;
  7704. end;
  7705. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7706. function TglBitmap2D.FlipHorz: Boolean;
  7707. var
  7708. Col, Row: Integer;
  7709. TempDestData, DestData, SourceData: PByte;
  7710. ImgSize: Integer;
  7711. begin
  7712. result := inherited FlipHorz;
  7713. if Assigned(Data) then begin
  7714. SourceData := Data;
  7715. ImgSize := Height * fRowSize;
  7716. GetMem(DestData, ImgSize);
  7717. try
  7718. TempDestData := DestData;
  7719. Dec(TempDestData, fRowSize + fPixelSize);
  7720. for Row := 0 to Height -1 do begin
  7721. Inc(TempDestData, fRowSize * 2);
  7722. for Col := 0 to Width -1 do begin
  7723. Move(SourceData^, TempDestData^, fPixelSize);
  7724. Inc(SourceData, fPixelSize);
  7725. Dec(TempDestData, fPixelSize);
  7726. end;
  7727. end;
  7728. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7729. result := true;
  7730. except
  7731. if Assigned(DestData) then
  7732. FreeMem(DestData);
  7733. raise;
  7734. end;
  7735. end;
  7736. end;
  7737. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7738. function TglBitmap2D.FlipVert: Boolean;
  7739. var
  7740. Row: Integer;
  7741. TempDestData, DestData, SourceData: PByte;
  7742. begin
  7743. result := inherited FlipVert;
  7744. if Assigned(Data) then begin
  7745. SourceData := Data;
  7746. GetMem(DestData, Height * fRowSize);
  7747. try
  7748. TempDestData := DestData;
  7749. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7750. for Row := 0 to Height -1 do begin
  7751. Move(SourceData^, TempDestData^, fRowSize);
  7752. Dec(TempDestData, fRowSize);
  7753. Inc(SourceData, fRowSize);
  7754. end;
  7755. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7756. result := true;
  7757. except
  7758. if Assigned(DestData) then
  7759. FreeMem(DestData);
  7760. raise;
  7761. end;
  7762. end;
  7763. end;
  7764. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7765. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7766. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7767. type
  7768. TMatrixItem = record
  7769. X, Y: Integer;
  7770. W: Single;
  7771. end;
  7772. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7773. TglBitmapToNormalMapRec = Record
  7774. Scale: Single;
  7775. Heights: array of Single;
  7776. MatrixU : array of TMatrixItem;
  7777. MatrixV : array of TMatrixItem;
  7778. end;
  7779. const
  7780. ONE_OVER_255 = 1 / 255;
  7781. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7782. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7783. var
  7784. Val: Single;
  7785. begin
  7786. with FuncRec do begin
  7787. Val :=
  7788. Source.Data.r * LUMINANCE_WEIGHT_R +
  7789. Source.Data.g * LUMINANCE_WEIGHT_G +
  7790. Source.Data.b * LUMINANCE_WEIGHT_B;
  7791. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7792. end;
  7793. end;
  7794. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7795. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7796. begin
  7797. with FuncRec do
  7798. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7799. end;
  7800. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7801. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7802. type
  7803. TVec = Array[0..2] of Single;
  7804. var
  7805. Idx: Integer;
  7806. du, dv: Double;
  7807. Len: Single;
  7808. Vec: TVec;
  7809. function GetHeight(X, Y: Integer): Single;
  7810. begin
  7811. with FuncRec do begin
  7812. X := Max(0, Min(Size.X -1, X));
  7813. Y := Max(0, Min(Size.Y -1, Y));
  7814. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7815. end;
  7816. end;
  7817. begin
  7818. with FuncRec do begin
  7819. with PglBitmapToNormalMapRec(Args)^ do begin
  7820. du := 0;
  7821. for Idx := Low(MatrixU) to High(MatrixU) do
  7822. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7823. dv := 0;
  7824. for Idx := Low(MatrixU) to High(MatrixU) do
  7825. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7826. Vec[0] := -du * Scale;
  7827. Vec[1] := -dv * Scale;
  7828. Vec[2] := 1;
  7829. end;
  7830. // Normalize
  7831. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7832. if Len <> 0 then begin
  7833. Vec[0] := Vec[0] * Len;
  7834. Vec[1] := Vec[1] * Len;
  7835. Vec[2] := Vec[2] * Len;
  7836. end;
  7837. // Farbe zuweisem
  7838. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7839. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7840. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7841. end;
  7842. end;
  7843. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7844. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7845. var
  7846. Rec: TglBitmapToNormalMapRec;
  7847. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7848. begin
  7849. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7850. Matrix[Index].X := X;
  7851. Matrix[Index].Y := Y;
  7852. Matrix[Index].W := W;
  7853. end;
  7854. end;
  7855. begin
  7856. if TFormatDescriptor.Get(Format).IsCompressed then
  7857. raise EglBitmapUnsupportedFormat.Create(Format);
  7858. if aScale > 100 then
  7859. Rec.Scale := 100
  7860. else if aScale < -100 then
  7861. Rec.Scale := -100
  7862. else
  7863. Rec.Scale := aScale;
  7864. SetLength(Rec.Heights, Width * Height);
  7865. try
  7866. case aFunc of
  7867. nm4Samples: begin
  7868. SetLength(Rec.MatrixU, 2);
  7869. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7870. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7871. SetLength(Rec.MatrixV, 2);
  7872. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7873. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7874. end;
  7875. nmSobel: begin
  7876. SetLength(Rec.MatrixU, 6);
  7877. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7878. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7879. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7880. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7881. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7882. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7883. SetLength(Rec.MatrixV, 6);
  7884. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7885. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7886. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7887. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7888. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7889. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7890. end;
  7891. nm3x3: begin
  7892. SetLength(Rec.MatrixU, 6);
  7893. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7894. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7895. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7896. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7897. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7898. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7899. SetLength(Rec.MatrixV, 6);
  7900. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7901. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7902. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7903. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7904. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7905. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7906. end;
  7907. nm5x5: begin
  7908. SetLength(Rec.MatrixU, 20);
  7909. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7910. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7911. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7912. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7913. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7914. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7915. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7916. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7917. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7918. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7919. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7920. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7921. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7922. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7923. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7924. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7925. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7926. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7927. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7928. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7929. SetLength(Rec.MatrixV, 20);
  7930. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7931. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7932. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7933. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7934. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7935. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7936. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7937. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7938. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7939. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7940. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7941. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7942. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7943. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7944. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7945. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7946. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7947. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7948. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7949. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7950. end;
  7951. end;
  7952. // Daten Sammeln
  7953. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7954. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7955. else
  7956. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7957. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7958. finally
  7959. SetLength(Rec.Heights, 0);
  7960. end;
  7961. end;
  7962. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7963. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7964. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7966. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7967. begin
  7968. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7969. end;
  7970. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7971. procedure TglBitmapCubeMap.AfterConstruction;
  7972. begin
  7973. inherited;
  7974. {$IFNDEF OPENGL_ES}
  7975. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7976. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7977. {$ELSE}
  7978. if not (GL_VERSION_2_0) then
  7979. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7980. {$ENDIF}
  7981. SetWrap;
  7982. Target := GL_TEXTURE_CUBE_MAP;
  7983. {$IFNDEF OPENGL_ES}
  7984. fGenMode := GL_REFLECTION_MAP;
  7985. {$ENDIF}
  7986. end;
  7987. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7988. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7989. var
  7990. {$IFNDEF OPENGL_ES}
  7991. BuildWithGlu: Boolean;
  7992. {$ENDIF}
  7993. TexSize: Integer;
  7994. begin
  7995. if (aTestTextureSize) then begin
  7996. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7997. if (Height > TexSize) or (Width > TexSize) then
  7998. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7999. {$IF NOT DEFINED(OPENGL_ES)}
  8000. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  8001. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  8002. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  8003. if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) and not GL_OES_texture_npot then
  8004. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  8005. {$ELSE}
  8006. if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) then
  8007. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  8008. {$IFEND}
  8009. end;
  8010. if (ID = 0) then
  8011. CreateID;
  8012. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  8013. UploadData(aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  8014. end;
  8015. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8016. procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
  8017. begin
  8018. inherited Bind (aEnableTextureUnit);
  8019. {$IFNDEF OPENGL_ES}
  8020. if aEnableTexCoordsGen then begin
  8021. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  8022. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  8023. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  8024. glEnable(GL_TEXTURE_GEN_S);
  8025. glEnable(GL_TEXTURE_GEN_T);
  8026. glEnable(GL_TEXTURE_GEN_R);
  8027. end;
  8028. {$ENDIF}
  8029. end;
  8030. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8031. procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
  8032. begin
  8033. inherited Unbind(aDisableTextureUnit);
  8034. {$IFNDEF OPENGL_ES}
  8035. if aDisableTexCoordsGen then begin
  8036. glDisable(GL_TEXTURE_GEN_S);
  8037. glDisable(GL_TEXTURE_GEN_T);
  8038. glDisable(GL_TEXTURE_GEN_R);
  8039. end;
  8040. {$ENDIF}
  8041. end;
  8042. {$IFEND}
  8043. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  8044. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8045. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8047. type
  8048. TVec = Array[0..2] of Single;
  8049. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8050. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  8051. TglBitmapNormalMapRec = record
  8052. HalfSize : Integer;
  8053. Func: TglBitmapNormalMapGetVectorFunc;
  8054. end;
  8055. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8056. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8057. begin
  8058. aVec[0] := aHalfSize;
  8059. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  8060. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  8061. end;
  8062. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8063. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8064. begin
  8065. aVec[0] := - aHalfSize;
  8066. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  8067. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  8068. end;
  8069. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8070. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8071. begin
  8072. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  8073. aVec[1] := aHalfSize;
  8074. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  8075. end;
  8076. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8077. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8078. begin
  8079. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  8080. aVec[1] := - aHalfSize;
  8081. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  8082. end;
  8083. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8084. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8085. begin
  8086. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  8087. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  8088. aVec[2] := aHalfSize;
  8089. end;
  8090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8091. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8092. begin
  8093. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  8094. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  8095. aVec[2] := - aHalfSize;
  8096. end;
  8097. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8098. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  8099. var
  8100. i: Integer;
  8101. Vec: TVec;
  8102. Len: Single;
  8103. begin
  8104. with FuncRec do begin
  8105. with PglBitmapNormalMapRec(Args)^ do begin
  8106. Func(Vec, Position, HalfSize);
  8107. // Normalize
  8108. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  8109. if Len <> 0 then begin
  8110. Vec[0] := Vec[0] * Len;
  8111. Vec[1] := Vec[1] * Len;
  8112. Vec[2] := Vec[2] * Len;
  8113. end;
  8114. // Scale Vector and AddVectro
  8115. Vec[0] := Vec[0] * 0.5 + 0.5;
  8116. Vec[1] := Vec[1] * 0.5 + 0.5;
  8117. Vec[2] := Vec[2] * 0.5 + 0.5;
  8118. end;
  8119. // Set Color
  8120. for i := 0 to 2 do
  8121. Dest.Data.arr[i] := Round(Vec[i] * 255);
  8122. end;
  8123. end;
  8124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8125. procedure TglBitmapNormalMap.AfterConstruction;
  8126. begin
  8127. inherited;
  8128. {$IFNDEF OPENGL_ES}
  8129. fGenMode := GL_NORMAL_MAP;
  8130. {$ENDIF}
  8131. end;
  8132. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8133. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  8134. var
  8135. Rec: TglBitmapNormalMapRec;
  8136. SizeRec: TglBitmapPixelPosition;
  8137. begin
  8138. Rec.HalfSize := aSize div 2;
  8139. FreeDataAfterGenTexture := false;
  8140. SizeRec.Fields := [ffX, ffY];
  8141. SizeRec.X := aSize;
  8142. SizeRec.Y := aSize;
  8143. // Positive X
  8144. Rec.Func := glBitmapNormalMapPosX;
  8145. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8146. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  8147. // Negative X
  8148. Rec.Func := glBitmapNormalMapNegX;
  8149. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8150. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  8151. // Positive Y
  8152. Rec.Func := glBitmapNormalMapPosY;
  8153. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8154. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  8155. // Negative Y
  8156. Rec.Func := glBitmapNormalMapNegY;
  8157. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8158. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  8159. // Positive Z
  8160. Rec.Func := glBitmapNormalMapPosZ;
  8161. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8162. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  8163. // Negative Z
  8164. Rec.Func := glBitmapNormalMapNegZ;
  8165. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8166. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  8167. end;
  8168. {$IFEND}
  8169. initialization
  8170. glBitmapSetDefaultFormat (tfEmpty);
  8171. glBitmapSetDefaultMipmap (mmMipmap);
  8172. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  8173. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  8174. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  8175. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  8176. {$IFEND}
  8177. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  8178. glBitmapSetDefaultDeleteTextureOnFree (true);
  8179. TFormatDescriptor.Init;
  8180. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  8181. OpenGLInitialized := false;
  8182. InitOpenGLCS := TCriticalSection.Create;
  8183. {$ENDIF}
  8184. finalization
  8185. TFormatDescriptor.Finalize;
  8186. {$IFDEF GLB_NATIVE_OGL}
  8187. if Assigned(GL_LibHandle) then
  8188. glbFreeLibrary(GL_LibHandle);
  8189. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  8190. if Assigned(GLU_LibHandle) then
  8191. glbFreeLibrary(GLU_LibHandle);
  8192. FreeAndNil(InitOpenGLCS);
  8193. {$ENDIF}
  8194. {$ENDIF}
  8195. end.