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

9287 lines
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. TglcBitmap2D = TglBitmap2D;
  1126. {$IF NOT DEFINED(OPENGL_ES)}
  1127. TglcBitmap1D = TglBitmap1D;
  1128. TglcBitmapCubeMap = TglBitmapCubeMap;
  1129. TglcBitmapNormalMap = TglBitmapNormalMap;
  1130. {$ELSEIF DEFINED(OPENGL_ES_2_0)}
  1131. TglcBitmapCubeMap = TglBitmapCubeMap;
  1132. TglcBitmapNormalMap = TglBitmapNormalMap;
  1133. {$IFEND}
  1134. const
  1135. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1136. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1137. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1138. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1139. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1140. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1141. procedure glBitmapSetDefaultWrap(
  1142. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1143. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1144. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1145. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1146. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1147. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1148. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1149. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1150. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1151. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1152. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1153. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1154. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1155. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1156. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1157. function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
  1158. var
  1159. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1160. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1161. glBitmapDefaultFormat: TglBitmapFormat;
  1162. glBitmapDefaultMipmap: TglBitmapMipMap;
  1163. glBitmapDefaultFilterMin: Cardinal;
  1164. glBitmapDefaultFilterMag: Cardinal;
  1165. glBitmapDefaultWrapS: Cardinal;
  1166. glBitmapDefaultWrapT: Cardinal;
  1167. glBitmapDefaultWrapR: Cardinal;
  1168. glDefaultSwizzle: array[0..3] of GLenum;
  1169. {$IFDEF GLB_DELPHI}
  1170. function CreateGrayPalette: HPALETTE;
  1171. {$ENDIF}
  1172. implementation
  1173. uses
  1174. Math, syncobjs, typinfo
  1175. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1176. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1177. type
  1178. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1179. public
  1180. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1181. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1182. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1183. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1184. function CreateMappingData: Pointer; virtual;
  1185. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1186. function IsEmpty: Boolean; virtual;
  1187. function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
  1188. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1189. constructor Create; virtual;
  1190. public
  1191. class procedure Init;
  1192. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1193. class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1194. class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
  1195. class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  1196. class procedure Clear;
  1197. class procedure Finalize;
  1198. end;
  1199. TFormatDescriptorClass = class of TFormatDescriptor;
  1200. TfdEmpty = class(TFormatDescriptor);
  1201. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1202. TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
  1203. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1204. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1205. end;
  1206. TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
  1207. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1208. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1209. end;
  1210. TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
  1211. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1212. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1213. end;
  1214. TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
  1215. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1216. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1217. end;
  1218. TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
  1219. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1220. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1221. end;
  1222. TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1223. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1224. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1225. end;
  1226. TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
  1227. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1228. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1229. end;
  1230. TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
  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. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1235. TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
  1236. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1237. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1238. end;
  1239. TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
  1240. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1241. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1242. end;
  1243. TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
  1244. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1245. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1246. end;
  1247. TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
  1248. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1249. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1250. end;
  1251. TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
  1252. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1253. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1254. end;
  1255. TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
  1256. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1257. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1258. end;
  1259. TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1260. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1261. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1262. end;
  1263. TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
  1264. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1265. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1266. end;
  1267. TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
  1268. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1269. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1270. end;
  1271. TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1272. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1273. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1274. end;
  1275. TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  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. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1280. TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
  1281. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1282. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1283. end;
  1284. TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
  1285. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1286. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1287. end;
  1288. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1289. TfdAlpha4ub1 = class(TfdAlphaUB1)
  1290. procedure SetValues; override;
  1291. end;
  1292. TfdAlpha8ub1 = class(TfdAlphaUB1)
  1293. procedure SetValues; override;
  1294. end;
  1295. TfdAlpha16us1 = class(TfdAlphaUS1)
  1296. procedure SetValues; override;
  1297. end;
  1298. TfdLuminance4ub1 = class(TfdLuminanceUB1)
  1299. procedure SetValues; override;
  1300. end;
  1301. TfdLuminance8ub1 = class(TfdLuminanceUB1)
  1302. procedure SetValues; override;
  1303. end;
  1304. TfdLuminance16us1 = class(TfdLuminanceUS1)
  1305. procedure SetValues; override;
  1306. end;
  1307. TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
  1308. procedure SetValues; override;
  1309. end;
  1310. TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
  1311. procedure SetValues; override;
  1312. end;
  1313. TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
  1314. procedure SetValues; override;
  1315. end;
  1316. TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
  1317. procedure SetValues; override;
  1318. end;
  1319. TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
  1320. procedure SetValues; override;
  1321. end;
  1322. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1323. TfdR3G3B2ub1 = class(TfdUniversalUB1)
  1324. procedure SetValues; override;
  1325. end;
  1326. TfdRGBX4us1 = class(TfdUniversalUS1)
  1327. procedure SetValues; override;
  1328. end;
  1329. TfdXRGB4us1 = class(TfdUniversalUS1)
  1330. procedure SetValues; override;
  1331. end;
  1332. TfdR5G6B5us1 = class(TfdUniversalUS1)
  1333. procedure SetValues; override;
  1334. end;
  1335. TfdRGB5X1us1 = class(TfdUniversalUS1)
  1336. procedure SetValues; override;
  1337. end;
  1338. TfdX1RGB5us1 = class(TfdUniversalUS1)
  1339. procedure SetValues; override;
  1340. end;
  1341. TfdRGB8ub3 = class(TfdRGBub3)
  1342. procedure SetValues; override;
  1343. end;
  1344. TfdRGBX8ui1 = class(TfdUniversalUI1)
  1345. procedure SetValues; override;
  1346. end;
  1347. TfdXRGB8ui1 = class(TfdUniversalUI1)
  1348. procedure SetValues; override;
  1349. end;
  1350. TfdRGB10X2ui1 = class(TfdUniversalUI1)
  1351. procedure SetValues; override;
  1352. end;
  1353. TfdX2RGB10ui1 = class(TfdUniversalUI1)
  1354. procedure SetValues; override;
  1355. end;
  1356. TfdRGB16us3 = class(TfdRGBus3)
  1357. procedure SetValues; override;
  1358. end;
  1359. TfdRGBA4us1 = class(TfdUniversalUS1)
  1360. procedure SetValues; override;
  1361. end;
  1362. TfdARGB4us1 = class(TfdUniversalUS1)
  1363. procedure SetValues; override;
  1364. end;
  1365. TfdRGB5A1us1 = class(TfdUniversalUS1)
  1366. procedure SetValues; override;
  1367. end;
  1368. TfdA1RGB5us1 = class(TfdUniversalUS1)
  1369. procedure SetValues; override;
  1370. end;
  1371. TfdRGBA8ui1 = class(TfdUniversalUI1)
  1372. procedure SetValues; override;
  1373. end;
  1374. TfdARGB8ui1 = class(TfdUniversalUI1)
  1375. procedure SetValues; override;
  1376. end;
  1377. TfdRGBA8ub4 = class(TfdRGBAub4)
  1378. procedure SetValues; override;
  1379. end;
  1380. TfdRGB10A2ui1 = class(TfdUniversalUI1)
  1381. procedure SetValues; override;
  1382. end;
  1383. TfdA2RGB10ui1 = class(TfdUniversalUI1)
  1384. procedure SetValues; override;
  1385. end;
  1386. TfdRGBA16us4 = class(TfdRGBAus4)
  1387. procedure SetValues; override;
  1388. end;
  1389. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1390. TfdBGRX4us1 = class(TfdUniversalUS1)
  1391. procedure SetValues; override;
  1392. end;
  1393. TfdXBGR4us1 = class(TfdUniversalUS1)
  1394. procedure SetValues; override;
  1395. end;
  1396. TfdB5G6R5us1 = class(TfdUniversalUS1)
  1397. procedure SetValues; override;
  1398. end;
  1399. TfdBGR5X1us1 = class(TfdUniversalUS1)
  1400. procedure SetValues; override;
  1401. end;
  1402. TfdX1BGR5us1 = class(TfdUniversalUS1)
  1403. procedure SetValues; override;
  1404. end;
  1405. TfdBGR8ub3 = class(TfdBGRub3)
  1406. procedure SetValues; override;
  1407. end;
  1408. TfdBGRX8ui1 = class(TfdUniversalUI1)
  1409. procedure SetValues; override;
  1410. end;
  1411. TfdXBGR8ui1 = class(TfdUniversalUI1)
  1412. procedure SetValues; override;
  1413. end;
  1414. TfdBGR10X2ui1 = class(TfdUniversalUI1)
  1415. procedure SetValues; override;
  1416. end;
  1417. TfdX2BGR10ui1 = class(TfdUniversalUI1)
  1418. procedure SetValues; override;
  1419. end;
  1420. TfdBGR16us3 = class(TfdBGRus3)
  1421. procedure SetValues; override;
  1422. end;
  1423. TfdBGRA4us1 = class(TfdUniversalUS1)
  1424. procedure SetValues; override;
  1425. end;
  1426. TfdABGR4us1 = class(TfdUniversalUS1)
  1427. procedure SetValues; override;
  1428. end;
  1429. TfdBGR5A1us1 = class(TfdUniversalUS1)
  1430. procedure SetValues; override;
  1431. end;
  1432. TfdA1BGR5us1 = class(TfdUniversalUS1)
  1433. procedure SetValues; override;
  1434. end;
  1435. TfdBGRA8ui1 = class(TfdUniversalUI1)
  1436. procedure SetValues; override;
  1437. end;
  1438. TfdABGR8ui1 = class(TfdUniversalUI1)
  1439. procedure SetValues; override;
  1440. end;
  1441. TfdBGRA8ub4 = class(TfdBGRAub4)
  1442. procedure SetValues; override;
  1443. end;
  1444. TfdBGR10A2ui1 = class(TfdUniversalUI1)
  1445. procedure SetValues; override;
  1446. end;
  1447. TfdA2BGR10ui1 = class(TfdUniversalUI1)
  1448. procedure SetValues; override;
  1449. end;
  1450. TfdBGRA16us4 = class(TfdBGRAus4)
  1451. procedure SetValues; override;
  1452. end;
  1453. TfdDepth16us1 = class(TfdDepthUS1)
  1454. procedure SetValues; override;
  1455. end;
  1456. TfdDepth24ui1 = class(TfdDepthUI1)
  1457. procedure SetValues; override;
  1458. end;
  1459. TfdDepth32ui1 = class(TfdDepthUI1)
  1460. procedure SetValues; override;
  1461. end;
  1462. TfdS3tcDtx1RGBA = 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. TfdS3tcDtx3RGBA = 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. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1473. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1474. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1475. procedure SetValues; override;
  1476. end;
  1477. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1478. TbmpBitfieldFormat = class(TFormatDescriptor)
  1479. public
  1480. procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
  1481. procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1482. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1483. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1484. end;
  1485. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1486. TbmpColorTableEnty = packed record
  1487. b, g, r, a: Byte;
  1488. end;
  1489. TbmpColorTable = array of TbmpColorTableEnty;
  1490. TbmpColorTableFormat = class(TFormatDescriptor)
  1491. private
  1492. fBitsPerPixel: Integer;
  1493. fColorTable: TbmpColorTable;
  1494. protected
  1495. procedure SetValues; override;
  1496. public
  1497. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1498. property BitsPerPixel: Integer read fBitsPerPixel write fBitsPerPixel;
  1499. procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1500. procedure CalcValues;
  1501. procedure CreateColorTable;
  1502. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1503. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1504. destructor Destroy; override;
  1505. end;
  1506. const
  1507. LUMINANCE_WEIGHT_R = 0.30;
  1508. LUMINANCE_WEIGHT_G = 0.59;
  1509. LUMINANCE_WEIGHT_B = 0.11;
  1510. ALPHA_WEIGHT_R = 0.30;
  1511. ALPHA_WEIGHT_G = 0.59;
  1512. ALPHA_WEIGHT_B = 0.11;
  1513. DEPTH_WEIGHT_R = 0.333333333;
  1514. DEPTH_WEIGHT_G = 0.333333333;
  1515. DEPTH_WEIGHT_B = 0.333333333;
  1516. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1517. TfdEmpty,
  1518. TfdAlpha4ub1,
  1519. TfdAlpha8ub1,
  1520. TfdAlpha16us1,
  1521. TfdLuminance4ub1,
  1522. TfdLuminance8ub1,
  1523. TfdLuminance16us1,
  1524. TfdLuminance4Alpha4ub2,
  1525. TfdLuminance6Alpha2ub2,
  1526. TfdLuminance8Alpha8ub2,
  1527. TfdLuminance12Alpha4us2,
  1528. TfdLuminance16Alpha16us2,
  1529. TfdR3G3B2ub1,
  1530. TfdRGBX4us1,
  1531. TfdXRGB4us1,
  1532. TfdR5G6B5us1,
  1533. TfdRGB5X1us1,
  1534. TfdX1RGB5us1,
  1535. TfdRGB8ub3,
  1536. TfdRGBX8ui1,
  1537. TfdXRGB8ui1,
  1538. TfdRGB10X2ui1,
  1539. TfdX2RGB10ui1,
  1540. TfdRGB16us3,
  1541. TfdRGBA4us1,
  1542. TfdARGB4us1,
  1543. TfdRGB5A1us1,
  1544. TfdA1RGB5us1,
  1545. TfdRGBA8ui1,
  1546. TfdARGB8ui1,
  1547. TfdRGBA8ub4,
  1548. TfdRGB10A2ui1,
  1549. TfdA2RGB10ui1,
  1550. TfdRGBA16us4,
  1551. TfdBGRX4us1,
  1552. TfdXBGR4us1,
  1553. TfdB5G6R5us1,
  1554. TfdBGR5X1us1,
  1555. TfdX1BGR5us1,
  1556. TfdBGR8ub3,
  1557. TfdBGRX8ui1,
  1558. TfdXBGR8ui1,
  1559. TfdBGR10X2ui1,
  1560. TfdX2BGR10ui1,
  1561. TfdBGR16us3,
  1562. TfdBGRA4us1,
  1563. TfdABGR4us1,
  1564. TfdBGR5A1us1,
  1565. TfdA1BGR5us1,
  1566. TfdBGRA8ui1,
  1567. TfdABGR8ui1,
  1568. TfdBGRA8ub4,
  1569. TfdBGR10A2ui1,
  1570. TfdA2BGR10ui1,
  1571. TfdBGRA16us4,
  1572. TfdDepth16us1,
  1573. TfdDepth24ui1,
  1574. TfdDepth32ui1,
  1575. TfdS3tcDtx1RGBA,
  1576. TfdS3tcDtx3RGBA,
  1577. TfdS3tcDtx5RGBA
  1578. );
  1579. var
  1580. FormatDescriptorCS: TCriticalSection;
  1581. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1582. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1583. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1584. begin
  1585. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1586. end;
  1587. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1588. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1589. begin
  1590. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1591. end;
  1592. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1593. function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
  1594. begin
  1595. result.Fields := [];
  1596. if X >= 0 then
  1597. result.Fields := result.Fields + [ffX];
  1598. if Y >= 0 then
  1599. result.Fields := result.Fields + [ffY];
  1600. result.X := Max(0, X);
  1601. result.Y := Max(0, Y);
  1602. end;
  1603. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1604. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1605. begin
  1606. result.r := r;
  1607. result.g := g;
  1608. result.b := b;
  1609. result.a := a;
  1610. end;
  1611. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1612. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1613. begin
  1614. result.r := r;
  1615. result.g := g;
  1616. result.b := b;
  1617. result.a := a;
  1618. end;
  1619. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1620. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1621. begin
  1622. result.r := r;
  1623. result.g := g;
  1624. result.b := b;
  1625. result.a := a;
  1626. end;
  1627. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1628. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1629. var
  1630. i: Integer;
  1631. begin
  1632. result := false;
  1633. for i := 0 to high(r1.arr) do
  1634. if (r1.arr[i] <> r2.arr[i]) then
  1635. exit;
  1636. result := true;
  1637. end;
  1638. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1639. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1640. var
  1641. i: Integer;
  1642. begin
  1643. result := false;
  1644. for i := 0 to high(r1.arr) do
  1645. if (r1.arr[i] <> r2.arr[i]) then
  1646. exit;
  1647. result := true;
  1648. end;
  1649. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1650. function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
  1651. var
  1652. desc: TFormatDescriptor;
  1653. p, tmp: PByte;
  1654. x, y, i: Integer;
  1655. md: Pointer;
  1656. px: TglBitmapPixelData;
  1657. begin
  1658. result := nil;
  1659. desc := TFormatDescriptor.Get(aFormat);
  1660. if (desc.IsCompressed) or (desc.glFormat = 0) then
  1661. exit;
  1662. p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
  1663. md := desc.CreateMappingData;
  1664. try
  1665. tmp := p;
  1666. desc.PreparePixel(px);
  1667. for y := 0 to 4 do
  1668. for x := 0 to 4 do begin
  1669. px.Data := glBitmapRec4ui(0, 0, 0, 0);
  1670. for i := 0 to 3 do begin
  1671. if ((y < 3) and (y = i)) or
  1672. ((y = 3) and (i < 3)) or
  1673. ((y = 4) and (i = 3))
  1674. then
  1675. px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
  1676. else if ((y < 4) and (i = 3)) or
  1677. ((y = 4) and (i < 3))
  1678. then
  1679. px.Data.arr[i] := px.Range.arr[i]
  1680. else
  1681. px.Data.arr[i] := 0; //px.Range.arr[i];
  1682. end;
  1683. desc.Map(px, tmp, md);
  1684. end;
  1685. finally
  1686. desc.FreeMappingData(md);
  1687. end;
  1688. result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
  1689. result.FreeDataOnDestroy := true;
  1690. result.FreeDataAfterGenTexture := false;
  1691. result.SetFilter(GL_NEAREST, GL_NEAREST);
  1692. end;
  1693. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1694. function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
  1695. begin
  1696. result.r := r;
  1697. result.g := g;
  1698. result.b := b;
  1699. result.a := a;
  1700. end;
  1701. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1702. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1703. begin
  1704. result := [];
  1705. if (aFormat in [
  1706. //8bpp
  1707. tfAlpha4ub1, tfAlpha8ub1,
  1708. tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
  1709. //16bpp
  1710. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1711. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  1712. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
  1713. //24bpp
  1714. tfBGR8ub3, tfRGB8ub3,
  1715. //32bpp
  1716. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  1717. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
  1718. then
  1719. result := result + [ ftBMP ];
  1720. if (aFormat in [
  1721. //8bbp
  1722. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
  1723. //16bbp
  1724. tfAlpha16us1, tfLuminance16us1,
  1725. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1726. tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
  1727. //24bbp
  1728. tfBGR8ub3,
  1729. //32bbp
  1730. tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
  1731. tfDepth24ui1, tfDepth32ui1])
  1732. then
  1733. result := result + [ftTGA];
  1734. if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
  1735. result := result + [ftDDS];
  1736. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1737. if aFormat in [
  1738. tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
  1739. tfRGB8ub3, tfRGBA8ui1,
  1740. tfBGR8ub3, tfBGRA8ui1] then
  1741. result := result + [ftPNG];
  1742. {$ENDIF}
  1743. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1744. if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
  1745. result := result + [ftJPEG];
  1746. {$ENDIF}
  1747. end;
  1748. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1749. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1750. begin
  1751. while (aNumber and 1) = 0 do
  1752. aNumber := aNumber shr 1;
  1753. result := aNumber = 1;
  1754. end;
  1755. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1756. function GetTopMostBit(aBitSet: QWord): Integer;
  1757. begin
  1758. result := 0;
  1759. while aBitSet > 0 do begin
  1760. inc(result);
  1761. aBitSet := aBitSet shr 1;
  1762. end;
  1763. end;
  1764. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1765. function CountSetBits(aBitSet: QWord): Integer;
  1766. begin
  1767. result := 0;
  1768. while aBitSet > 0 do begin
  1769. if (aBitSet and 1) = 1 then
  1770. inc(result);
  1771. aBitSet := aBitSet shr 1;
  1772. end;
  1773. end;
  1774. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1775. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1776. begin
  1777. result := Trunc(
  1778. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1779. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1780. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1781. end;
  1782. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1783. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1784. begin
  1785. result := Trunc(
  1786. DEPTH_WEIGHT_R * aPixel.Data.r +
  1787. DEPTH_WEIGHT_G * aPixel.Data.g +
  1788. DEPTH_WEIGHT_B * aPixel.Data.b);
  1789. end;
  1790. {$IFDEF GLB_NATIVE_OGL}
  1791. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1792. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1793. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1794. var
  1795. GL_LibHandle: Pointer = nil;
  1796. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
  1797. begin
  1798. if not Assigned(aLibHandle) then
  1799. aLibHandle := GL_LibHandle;
  1800. {$IF DEFINED(GLB_WIN)}
  1801. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1802. if Assigned(result) then
  1803. exit;
  1804. if Assigned(wglGetProcAddress) then
  1805. result := wglGetProcAddress(aProcName);
  1806. {$ELSEIF DEFINED(GLB_LINUX)}
  1807. if Assigned(glXGetProcAddress) then begin
  1808. result := glXGetProcAddress(aProcName);
  1809. if Assigned(result) then
  1810. exit;
  1811. end;
  1812. if Assigned(glXGetProcAddressARB) then begin
  1813. result := glXGetProcAddressARB(aProcName);
  1814. if Assigned(result) then
  1815. exit;
  1816. end;
  1817. result := dlsym(aLibHandle, aProcName);
  1818. {$IFEND}
  1819. if not Assigned(result) and aRaiseOnErr then
  1820. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1821. end;
  1822. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1823. var
  1824. GLU_LibHandle: Pointer = nil;
  1825. OpenGLInitialized: Boolean;
  1826. InitOpenGLCS: TCriticalSection;
  1827. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1828. procedure glbInitOpenGL;
  1829. ////////////////////////////////////////////////////////////////////////////////
  1830. function glbLoadLibrary(const aName: PChar): Pointer;
  1831. begin
  1832. {$IF DEFINED(GLB_WIN)}
  1833. result := {%H-}Pointer(LoadLibrary(aName));
  1834. {$ELSEIF DEFINED(GLB_LINUX)}
  1835. result := dlopen(Name, RTLD_LAZY);
  1836. {$ELSE}
  1837. result := nil;
  1838. {$IFEND}
  1839. end;
  1840. ////////////////////////////////////////////////////////////////////////////////
  1841. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1842. begin
  1843. result := false;
  1844. if not Assigned(aLibHandle) then
  1845. exit;
  1846. {$IF DEFINED(GLB_WIN)}
  1847. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1848. {$ELSEIF DEFINED(GLB_LINUX)}
  1849. Result := dlclose(aLibHandle) = 0;
  1850. {$IFEND}
  1851. end;
  1852. begin
  1853. if Assigned(GL_LibHandle) then
  1854. glbFreeLibrary(GL_LibHandle);
  1855. if Assigned(GLU_LibHandle) then
  1856. glbFreeLibrary(GLU_LibHandle);
  1857. GL_LibHandle := glbLoadLibrary(libopengl);
  1858. if not Assigned(GL_LibHandle) then
  1859. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1860. GLU_LibHandle := glbLoadLibrary(libglu);
  1861. if not Assigned(GLU_LibHandle) then
  1862. raise EglBitmap.Create('unable to load library: ' + libglu);
  1863. {$IF DEFINED(GLB_WIN)}
  1864. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1865. {$ELSEIF DEFINED(GLB_LINUX)}
  1866. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1867. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1868. {$IFEND}
  1869. glEnable := glbGetProcAddress('glEnable');
  1870. glDisable := glbGetProcAddress('glDisable');
  1871. glGetString := glbGetProcAddress('glGetString');
  1872. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1873. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1874. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1875. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1876. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1877. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1878. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1879. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1880. glTexGeni := glbGetProcAddress('glTexGeni');
  1881. glGenTextures := glbGetProcAddress('glGenTextures');
  1882. glBindTexture := glbGetProcAddress('glBindTexture');
  1883. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1884. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1885. glReadPixels := glbGetProcAddress('glReadPixels');
  1886. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1887. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1888. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1889. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1890. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1891. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1892. end;
  1893. {$ENDIF}
  1894. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1895. procedure glbReadOpenGLExtensions;
  1896. var
  1897. Buffer: AnsiString;
  1898. MajorVersion, MinorVersion: Integer;
  1899. ///////////////////////////////////////////////////////////////////////////////////////////
  1900. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1901. var
  1902. Separator: Integer;
  1903. begin
  1904. aMinor := 0;
  1905. aMajor := 0;
  1906. Separator := Pos(AnsiString('.'), aBuffer);
  1907. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1908. (aBuffer[Separator - 1] in ['0'..'9']) and
  1909. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1910. Dec(Separator);
  1911. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1912. Dec(Separator);
  1913. Delete(aBuffer, 1, Separator);
  1914. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1915. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1916. Inc(Separator);
  1917. Delete(aBuffer, Separator, 255);
  1918. Separator := Pos(AnsiString('.'), aBuffer);
  1919. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1920. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1921. end;
  1922. end;
  1923. ///////////////////////////////////////////////////////////////////////////////////////////
  1924. function CheckExtension(const Extension: AnsiString): Boolean;
  1925. var
  1926. ExtPos: Integer;
  1927. begin
  1928. ExtPos := Pos(Extension, Buffer);
  1929. result := ExtPos > 0;
  1930. if result then
  1931. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1932. end;
  1933. ///////////////////////////////////////////////////////////////////////////////////////////
  1934. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1935. begin
  1936. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1937. end;
  1938. begin
  1939. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1940. InitOpenGLCS.Enter;
  1941. try
  1942. if not OpenGLInitialized then begin
  1943. glbInitOpenGL;
  1944. OpenGLInitialized := true;
  1945. end;
  1946. finally
  1947. InitOpenGLCS.Leave;
  1948. end;
  1949. {$ENDIF}
  1950. // Version
  1951. Buffer := glGetString(GL_VERSION);
  1952. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1953. GL_VERSION_1_2 := CheckVersion(1, 2);
  1954. GL_VERSION_1_3 := CheckVersion(1, 3);
  1955. GL_VERSION_1_4 := CheckVersion(1, 4);
  1956. GL_VERSION_2_0 := CheckVersion(2, 0);
  1957. GL_VERSION_3_3 := CheckVersion(3, 3);
  1958. // Extensions
  1959. Buffer := glGetString(GL_EXTENSIONS);
  1960. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1961. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1962. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1963. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1964. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1965. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1966. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1967. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1968. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1969. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1970. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1971. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1972. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1973. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1974. if GL_VERSION_1_3 then begin
  1975. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1976. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1977. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1978. end else begin
  1979. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false);
  1980. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false);
  1981. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
  1982. end;
  1983. end;
  1984. {$ENDIF}
  1985. {$IFDEF GLB_SDL_IMAGE}
  1986. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1987. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1988. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1989. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1990. begin
  1991. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1992. end;
  1993. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1994. begin
  1995. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1996. end;
  1997. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1998. begin
  1999. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  2000. end;
  2001. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  2002. begin
  2003. result := 0;
  2004. end;
  2005. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  2006. begin
  2007. result := SDL_AllocRW;
  2008. if result = nil then
  2009. raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  2010. result^.seek := glBitmapRWseek;
  2011. result^.read := glBitmapRWread;
  2012. result^.write := glBitmapRWwrite;
  2013. result^.close := glBitmapRWclose;
  2014. result^.unknown.data1 := Stream;
  2015. end;
  2016. {$ENDIF}
  2017. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2018. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  2019. begin
  2020. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  2021. end;
  2022. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2023. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  2024. begin
  2025. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  2026. end;
  2027. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2028. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  2029. begin
  2030. glBitmapDefaultMipmap := aValue;
  2031. end;
  2032. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2033. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  2034. begin
  2035. glBitmapDefaultFormat := aFormat;
  2036. end;
  2037. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2038. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  2039. begin
  2040. glBitmapDefaultFilterMin := aMin;
  2041. glBitmapDefaultFilterMag := aMag;
  2042. end;
  2043. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2044. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  2045. begin
  2046. glBitmapDefaultWrapS := S;
  2047. glBitmapDefaultWrapT := T;
  2048. glBitmapDefaultWrapR := R;
  2049. end;
  2050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2051. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2052. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  2053. begin
  2054. glDefaultSwizzle[0] := r;
  2055. glDefaultSwizzle[1] := g;
  2056. glDefaultSwizzle[2] := b;
  2057. glDefaultSwizzle[3] := a;
  2058. end;
  2059. {$IFEND}
  2060. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2061. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  2062. begin
  2063. result := glBitmapDefaultDeleteTextureOnFree;
  2064. end;
  2065. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2066. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  2067. begin
  2068. result := glBitmapDefaultFreeDataAfterGenTextures;
  2069. end;
  2070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2071. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  2072. begin
  2073. result := glBitmapDefaultMipmap;
  2074. end;
  2075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2076. function glBitmapGetDefaultFormat: TglBitmapFormat;
  2077. begin
  2078. result := glBitmapDefaultFormat;
  2079. end;
  2080. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2081. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  2082. begin
  2083. aMin := glBitmapDefaultFilterMin;
  2084. aMag := glBitmapDefaultFilterMag;
  2085. end;
  2086. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2087. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  2088. begin
  2089. S := glBitmapDefaultWrapS;
  2090. T := glBitmapDefaultWrapT;
  2091. R := glBitmapDefaultWrapR;
  2092. end;
  2093. {$IFNDEF OPENGL_ES}
  2094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2095. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  2096. begin
  2097. r := glDefaultSwizzle[0];
  2098. g := glDefaultSwizzle[1];
  2099. b := glDefaultSwizzle[2];
  2100. a := glDefaultSwizzle[3];
  2101. end;
  2102. {$ENDIF}
  2103. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2104. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2106. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  2107. var
  2108. w, h: Integer;
  2109. begin
  2110. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  2111. w := Max(1, aSize.X);
  2112. h := Max(1, aSize.Y);
  2113. result := GetSize(w, h);
  2114. end else
  2115. result := 0;
  2116. end;
  2117. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2118. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  2119. begin
  2120. result := 0;
  2121. if (aWidth <= 0) or (aHeight <= 0) then
  2122. exit;
  2123. result := Ceil(aWidth * aHeight * BytesPerPixel);
  2124. end;
  2125. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2126. function TFormatDescriptor.CreateMappingData: Pointer;
  2127. begin
  2128. result := nil;
  2129. end;
  2130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2131. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2132. begin
  2133. //DUMMY
  2134. end;
  2135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2136. function TFormatDescriptor.IsEmpty: Boolean;
  2137. begin
  2138. result := (fFormat = tfEmpty);
  2139. end;
  2140. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2141. function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
  2142. var
  2143. i: Integer;
  2144. m: TglBitmapRec4ul;
  2145. begin
  2146. result := false;
  2147. if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
  2148. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2149. m := Mask;
  2150. for i := 0 to 3 do
  2151. if (aMask.arr[i] <> m.arr[i]) then
  2152. exit;
  2153. result := true;
  2154. end;
  2155. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2156. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2157. begin
  2158. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2159. aPixel.Data := Range;
  2160. aPixel.Format := fFormat;
  2161. aPixel.Range := Range;
  2162. end;
  2163. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2164. constructor TFormatDescriptor.Create;
  2165. begin
  2166. inherited Create;
  2167. end;
  2168. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2169. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2170. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2171. procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2172. begin
  2173. aData^ := aPixel.Data.a;
  2174. inc(aData);
  2175. end;
  2176. procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2177. begin
  2178. aPixel.Data.r := 0;
  2179. aPixel.Data.g := 0;
  2180. aPixel.Data.b := 0;
  2181. aPixel.Data.a := aData^;
  2182. inc(aData);
  2183. end;
  2184. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2185. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2186. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2187. procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2188. begin
  2189. aData^ := LuminanceWeight(aPixel);
  2190. inc(aData);
  2191. end;
  2192. procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2193. begin
  2194. aPixel.Data.r := aData^;
  2195. aPixel.Data.g := aData^;
  2196. aPixel.Data.b := aData^;
  2197. aPixel.Data.a := 0;
  2198. inc(aData);
  2199. end;
  2200. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2201. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2202. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2203. procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2204. var
  2205. i: Integer;
  2206. begin
  2207. aData^ := 0;
  2208. for i := 0 to 3 do
  2209. if (Range.arr[i] > 0) then
  2210. aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2211. inc(aData);
  2212. end;
  2213. procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2214. var
  2215. i: Integer;
  2216. begin
  2217. for i := 0 to 3 do
  2218. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
  2219. inc(aData);
  2220. end;
  2221. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2222. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2223. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2224. procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2225. begin
  2226. inherited Map(aPixel, aData, aMapData);
  2227. aData^ := aPixel.Data.a;
  2228. inc(aData);
  2229. end;
  2230. procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2231. begin
  2232. inherited Unmap(aData, aPixel, aMapData);
  2233. aPixel.Data.a := aData^;
  2234. inc(aData);
  2235. end;
  2236. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2237. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2238. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2239. procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2240. begin
  2241. aData^ := aPixel.Data.r;
  2242. inc(aData);
  2243. aData^ := aPixel.Data.g;
  2244. inc(aData);
  2245. aData^ := aPixel.Data.b;
  2246. inc(aData);
  2247. end;
  2248. procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2249. begin
  2250. aPixel.Data.r := aData^;
  2251. inc(aData);
  2252. aPixel.Data.g := aData^;
  2253. inc(aData);
  2254. aPixel.Data.b := aData^;
  2255. inc(aData);
  2256. aPixel.Data.a := 0;
  2257. end;
  2258. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2259. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2260. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2261. procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2262. begin
  2263. aData^ := aPixel.Data.b;
  2264. inc(aData);
  2265. aData^ := aPixel.Data.g;
  2266. inc(aData);
  2267. aData^ := aPixel.Data.r;
  2268. inc(aData);
  2269. end;
  2270. procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2271. begin
  2272. aPixel.Data.b := aData^;
  2273. inc(aData);
  2274. aPixel.Data.g := aData^;
  2275. inc(aData);
  2276. aPixel.Data.r := aData^;
  2277. inc(aData);
  2278. aPixel.Data.a := 0;
  2279. end;
  2280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2281. //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2282. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2283. procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2284. begin
  2285. inherited Map(aPixel, aData, aMapData);
  2286. aData^ := aPixel.Data.a;
  2287. inc(aData);
  2288. end;
  2289. procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2290. begin
  2291. inherited Unmap(aData, aPixel, aMapData);
  2292. aPixel.Data.a := aData^;
  2293. inc(aData);
  2294. end;
  2295. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2296. //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2297. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2298. procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2299. begin
  2300. inherited Map(aPixel, aData, aMapData);
  2301. aData^ := aPixel.Data.a;
  2302. inc(aData);
  2303. end;
  2304. procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2305. begin
  2306. inherited Unmap(aData, aPixel, aMapData);
  2307. aPixel.Data.a := aData^;
  2308. inc(aData);
  2309. end;
  2310. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2311. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2312. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2313. procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2314. begin
  2315. PWord(aData)^ := aPixel.Data.a;
  2316. inc(aData, 2);
  2317. end;
  2318. procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2319. begin
  2320. aPixel.Data.r := 0;
  2321. aPixel.Data.g := 0;
  2322. aPixel.Data.b := 0;
  2323. aPixel.Data.a := PWord(aData)^;
  2324. inc(aData, 2);
  2325. end;
  2326. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2327. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2328. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2329. procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2330. begin
  2331. PWord(aData)^ := LuminanceWeight(aPixel);
  2332. inc(aData, 2);
  2333. end;
  2334. procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2335. begin
  2336. aPixel.Data.r := PWord(aData)^;
  2337. aPixel.Data.g := PWord(aData)^;
  2338. aPixel.Data.b := PWord(aData)^;
  2339. aPixel.Data.a := 0;
  2340. inc(aData, 2);
  2341. end;
  2342. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2343. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2344. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2345. procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2346. var
  2347. i: Integer;
  2348. begin
  2349. PWord(aData)^ := 0;
  2350. for i := 0 to 3 do
  2351. if (Range.arr[i] > 0) then
  2352. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2353. inc(aData, 2);
  2354. end;
  2355. procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2356. var
  2357. i: Integer;
  2358. begin
  2359. for i := 0 to 3 do
  2360. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2361. inc(aData, 2);
  2362. end;
  2363. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2364. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2365. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2366. procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2367. begin
  2368. PWord(aData)^ := DepthWeight(aPixel);
  2369. inc(aData, 2);
  2370. end;
  2371. procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2372. begin
  2373. aPixel.Data.r := PWord(aData)^;
  2374. aPixel.Data.g := PWord(aData)^;
  2375. aPixel.Data.b := PWord(aData)^;
  2376. aPixel.Data.a := PWord(aData)^;;
  2377. inc(aData, 2);
  2378. end;
  2379. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2380. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2381. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2382. procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2383. begin
  2384. inherited Map(aPixel, aData, aMapData);
  2385. PWord(aData)^ := aPixel.Data.a;
  2386. inc(aData, 2);
  2387. end;
  2388. procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2389. begin
  2390. inherited Unmap(aData, aPixel, aMapData);
  2391. aPixel.Data.a := PWord(aData)^;
  2392. inc(aData, 2);
  2393. end;
  2394. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2395. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2396. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2397. procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2398. begin
  2399. PWord(aData)^ := aPixel.Data.r;
  2400. inc(aData, 2);
  2401. PWord(aData)^ := aPixel.Data.g;
  2402. inc(aData, 2);
  2403. PWord(aData)^ := aPixel.Data.b;
  2404. inc(aData, 2);
  2405. end;
  2406. procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2407. begin
  2408. aPixel.Data.r := PWord(aData)^;
  2409. inc(aData, 2);
  2410. aPixel.Data.g := PWord(aData)^;
  2411. inc(aData, 2);
  2412. aPixel.Data.b := PWord(aData)^;
  2413. inc(aData, 2);
  2414. aPixel.Data.a := 0;
  2415. end;
  2416. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2417. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2418. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2419. procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2420. begin
  2421. PWord(aData)^ := aPixel.Data.b;
  2422. inc(aData, 2);
  2423. PWord(aData)^ := aPixel.Data.g;
  2424. inc(aData, 2);
  2425. PWord(aData)^ := aPixel.Data.r;
  2426. inc(aData, 2);
  2427. end;
  2428. procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2429. begin
  2430. aPixel.Data.b := PWord(aData)^;
  2431. inc(aData, 2);
  2432. aPixel.Data.g := PWord(aData)^;
  2433. inc(aData, 2);
  2434. aPixel.Data.r := PWord(aData)^;
  2435. inc(aData, 2);
  2436. aPixel.Data.a := 0;
  2437. end;
  2438. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2439. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2440. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2441. procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2442. begin
  2443. inherited Map(aPixel, aData, aMapData);
  2444. PWord(aData)^ := aPixel.Data.a;
  2445. inc(aData, 2);
  2446. end;
  2447. procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2448. begin
  2449. inherited Unmap(aData, aPixel, aMapData);
  2450. aPixel.Data.a := PWord(aData)^;
  2451. inc(aData, 2);
  2452. end;
  2453. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2454. //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2455. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2456. procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2457. begin
  2458. PWord(aData)^ := aPixel.Data.a;
  2459. inc(aData, 2);
  2460. inherited Map(aPixel, aData, aMapData);
  2461. end;
  2462. procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2463. begin
  2464. aPixel.Data.a := PWord(aData)^;
  2465. inc(aData, 2);
  2466. inherited Unmap(aData, aPixel, aMapData);
  2467. end;
  2468. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2469. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2470. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2471. procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2472. begin
  2473. inherited Map(aPixel, aData, aMapData);
  2474. PWord(aData)^ := aPixel.Data.a;
  2475. inc(aData, 2);
  2476. end;
  2477. procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2478. begin
  2479. inherited Unmap(aData, aPixel, aMapData);
  2480. aPixel.Data.a := PWord(aData)^;
  2481. inc(aData, 2);
  2482. end;
  2483. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2484. //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2485. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2486. procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2487. begin
  2488. PWord(aData)^ := aPixel.Data.a;
  2489. inc(aData, 2);
  2490. inherited Map(aPixel, aData, aMapData);
  2491. end;
  2492. procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2493. begin
  2494. aPixel.Data.a := PWord(aData)^;
  2495. inc(aData, 2);
  2496. inherited Unmap(aData, aPixel, aMapData);
  2497. end;
  2498. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2499. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2500. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2501. procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2502. var
  2503. i: Integer;
  2504. begin
  2505. PCardinal(aData)^ := 0;
  2506. for i := 0 to 3 do
  2507. if (Range.arr[i] > 0) then
  2508. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2509. inc(aData, 4);
  2510. end;
  2511. procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2512. var
  2513. i: Integer;
  2514. begin
  2515. for i := 0 to 3 do
  2516. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2517. inc(aData, 2);
  2518. end;
  2519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2520. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2521. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2522. procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2523. begin
  2524. PCardinal(aData)^ := DepthWeight(aPixel);
  2525. inc(aData, 4);
  2526. end;
  2527. procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2528. begin
  2529. aPixel.Data.r := PCardinal(aData)^;
  2530. aPixel.Data.g := PCardinal(aData)^;
  2531. aPixel.Data.b := PCardinal(aData)^;
  2532. aPixel.Data.a := PCardinal(aData)^;
  2533. inc(aData, 4);
  2534. end;
  2535. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2536. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2537. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2538. procedure TfdAlpha4ub1.SetValues;
  2539. begin
  2540. inherited SetValues;
  2541. fBitsPerPixel := 8;
  2542. fFormat := tfAlpha4ub1;
  2543. fWithAlpha := tfAlpha4ub1;
  2544. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2545. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2546. {$IFNDEF OPENGL_ES}
  2547. fOpenGLFormat := tfAlpha4ub1;
  2548. fglFormat := GL_ALPHA;
  2549. fglInternalFormat := GL_ALPHA4;
  2550. fglDataFormat := GL_UNSIGNED_BYTE;
  2551. {$ELSE}
  2552. fOpenGLFormat := tfAlpha8ub1;
  2553. {$ENDIF}
  2554. end;
  2555. procedure TfdAlpha8ub1.SetValues;
  2556. begin
  2557. inherited SetValues;
  2558. fBitsPerPixel := 8;
  2559. fFormat := tfAlpha8ub1;
  2560. fWithAlpha := tfAlpha8ub1;
  2561. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2562. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2563. fOpenGLFormat := tfAlpha8ub1;
  2564. fglFormat := GL_ALPHA;
  2565. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
  2566. fglDataFormat := GL_UNSIGNED_BYTE;
  2567. end;
  2568. procedure TfdAlpha16us1.SetValues;
  2569. begin
  2570. inherited SetValues;
  2571. fBitsPerPixel := 16;
  2572. fFormat := tfAlpha16us1;
  2573. fWithAlpha := tfAlpha16us1;
  2574. fPrecision := glBitmapRec4ub(0, 0, 0, 16);
  2575. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2576. {$IFNDEF OPENGL_ES}
  2577. fOpenGLFormat := tfAlpha16us1;
  2578. fglFormat := GL_ALPHA;
  2579. fglInternalFormat := GL_ALPHA16;
  2580. fglDataFormat := GL_UNSIGNED_SHORT;
  2581. {$ELSE}
  2582. fOpenGLFormat := tfAlpha8ub1;
  2583. {$ENDIF}
  2584. end;
  2585. procedure TfdLuminance4ub1.SetValues;
  2586. begin
  2587. inherited SetValues;
  2588. fBitsPerPixel := 8;
  2589. fFormat := tfLuminance4ub1;
  2590. fWithAlpha := tfLuminance4Alpha4ub2;
  2591. fWithoutAlpha := tfLuminance4ub1;
  2592. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2593. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2594. {$IFNDEF OPENGL_ES}
  2595. fOpenGLFormat := tfLuminance4ub1;
  2596. fglFormat := GL_LUMINANCE;
  2597. fglInternalFormat := GL_LUMINANCE4;
  2598. fglDataFormat := GL_UNSIGNED_BYTE;
  2599. {$ELSE}
  2600. fOpenGLFormat := tfLuminance8ub1;
  2601. {$ENDIF}
  2602. end;
  2603. procedure TfdLuminance8ub1.SetValues;
  2604. begin
  2605. inherited SetValues;
  2606. fBitsPerPixel := 8;
  2607. fFormat := tfLuminance8ub1;
  2608. fWithAlpha := tfLuminance8Alpha8ub2;
  2609. fWithoutAlpha := tfLuminance8ub1;
  2610. fOpenGLFormat := tfLuminance8ub1;
  2611. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2612. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2613. fglFormat := GL_LUMINANCE;
  2614. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
  2615. fglDataFormat := GL_UNSIGNED_BYTE;
  2616. end;
  2617. procedure TfdLuminance16us1.SetValues;
  2618. begin
  2619. inherited SetValues;
  2620. fBitsPerPixel := 16;
  2621. fFormat := tfLuminance16us1;
  2622. fWithAlpha := tfLuminance16Alpha16us2;
  2623. fWithoutAlpha := tfLuminance16us1;
  2624. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2625. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  2626. {$IFNDEF OPENGL_ES}
  2627. fOpenGLFormat := tfLuminance16us1;
  2628. fglFormat := GL_LUMINANCE;
  2629. fglInternalFormat := GL_LUMINANCE16;
  2630. fglDataFormat := GL_UNSIGNED_SHORT;
  2631. {$ELSE}
  2632. fOpenGLFormat := tfLuminance8ub1;
  2633. {$ENDIF}
  2634. end;
  2635. procedure TfdLuminance4Alpha4ub2.SetValues;
  2636. begin
  2637. inherited SetValues;
  2638. fBitsPerPixel := 16;
  2639. fFormat := tfLuminance4Alpha4ub2;
  2640. fWithAlpha := tfLuminance4Alpha4ub2;
  2641. fWithoutAlpha := tfLuminance4ub1;
  2642. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2643. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2644. {$IFNDEF OPENGL_ES}
  2645. fOpenGLFormat := tfLuminance4Alpha4ub2;
  2646. fglFormat := GL_LUMINANCE_ALPHA;
  2647. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2648. fglDataFormat := GL_UNSIGNED_BYTE;
  2649. {$ELSE}
  2650. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2651. {$ENDIF}
  2652. end;
  2653. procedure TfdLuminance6Alpha2ub2.SetValues;
  2654. begin
  2655. inherited SetValues;
  2656. fBitsPerPixel := 16;
  2657. fFormat := tfLuminance6Alpha2ub2;
  2658. fWithAlpha := tfLuminance6Alpha2ub2;
  2659. fWithoutAlpha := tfLuminance8ub1;
  2660. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2661. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2662. {$IFNDEF OPENGL_ES}
  2663. fOpenGLFormat := tfLuminance6Alpha2ub2;
  2664. fglFormat := GL_LUMINANCE_ALPHA;
  2665. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2666. fglDataFormat := GL_UNSIGNED_BYTE;
  2667. {$ELSE}
  2668. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2669. {$ENDIF}
  2670. end;
  2671. procedure TfdLuminance8Alpha8ub2.SetValues;
  2672. begin
  2673. inherited SetValues;
  2674. fBitsPerPixel := 16;
  2675. fFormat := tfLuminance8Alpha8ub2;
  2676. fWithAlpha := tfLuminance8Alpha8ub2;
  2677. fWithoutAlpha := tfLuminance8ub1;
  2678. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2679. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2680. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2681. fglFormat := GL_LUMINANCE_ALPHA;
  2682. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
  2683. fglDataFormat := GL_UNSIGNED_BYTE;
  2684. end;
  2685. procedure TfdLuminance12Alpha4us2.SetValues;
  2686. begin
  2687. inherited SetValues;
  2688. fBitsPerPixel := 32;
  2689. fFormat := tfLuminance12Alpha4us2;
  2690. fWithAlpha := tfLuminance12Alpha4us2;
  2691. fWithoutAlpha := tfLuminance16us1;
  2692. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2693. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2694. {$IFNDEF OPENGL_ES}
  2695. fOpenGLFormat := tfLuminance12Alpha4us2;
  2696. fglFormat := GL_LUMINANCE_ALPHA;
  2697. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2698. fglDataFormat := GL_UNSIGNED_SHORT;
  2699. {$ELSE}
  2700. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2701. {$ENDIF}
  2702. end;
  2703. procedure TfdLuminance16Alpha16us2.SetValues;
  2704. begin
  2705. inherited SetValues;
  2706. fBitsPerPixel := 32;
  2707. fFormat := tfLuminance16Alpha16us2;
  2708. fWithAlpha := tfLuminance16Alpha16us2;
  2709. fWithoutAlpha := tfLuminance16us1;
  2710. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2711. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2712. {$IFNDEF OPENGL_ES}
  2713. fOpenGLFormat := tfLuminance16Alpha16us2;
  2714. fglFormat := GL_LUMINANCE_ALPHA;
  2715. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2716. fglDataFormat := GL_UNSIGNED_SHORT;
  2717. {$ELSE}
  2718. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2719. {$ENDIF}
  2720. end;
  2721. procedure TfdR3G3B2ub1.SetValues;
  2722. begin
  2723. inherited SetValues;
  2724. fBitsPerPixel := 8;
  2725. fFormat := tfR3G3B2ub1;
  2726. fWithAlpha := tfRGBA4us1;
  2727. fWithoutAlpha := tfR3G3B2ub1;
  2728. fRGBInverted := tfEmpty;
  2729. fPrecision := glBitmapRec4ub(3, 3, 2, 0);
  2730. fShift := glBitmapRec4ub(5, 2, 0, 0);
  2731. {$IFNDEF OPENGL_ES}
  2732. fOpenGLFormat := tfR3G3B2ub1;
  2733. fglFormat := GL_RGB;
  2734. fglInternalFormat := GL_R3_G3_B2;
  2735. fglDataFormat := GL_UNSIGNED_BYTE_3_3_2;
  2736. {$ELSE}
  2737. fOpenGLFormat := tfR5G6B5us1;
  2738. {$ENDIF}
  2739. end;
  2740. procedure TfdRGBX4us1.SetValues;
  2741. begin
  2742. inherited SetValues;
  2743. fBitsPerPixel := 16;
  2744. fFormat := tfRGBX4us1;
  2745. fWithAlpha := tfRGBA4us1;
  2746. fWithoutAlpha := tfRGBX4us1;
  2747. fRGBInverted := tfBGRX4us1;
  2748. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2749. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2750. {$IFNDEF OPENGL_ES}
  2751. fOpenGLFormat := tfRGBX4us1;
  2752. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2753. fglInternalFormat := GL_RGB4;
  2754. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2755. {$ELSE}
  2756. fOpenGLFormat := tfR5G6B5us1;
  2757. {$ENDIF}
  2758. end;
  2759. procedure TfdXRGB4us1.SetValues;
  2760. begin
  2761. inherited SetValues;
  2762. fBitsPerPixel := 16;
  2763. fFormat := tfXRGB4us1;
  2764. fWithAlpha := tfARGB4us1;
  2765. fWithoutAlpha := tfXRGB4us1;
  2766. fRGBInverted := tfXBGR4us1;
  2767. fPrecision := glBitmapRec4ub(4, 4, 4, 0);
  2768. fShift := glBitmapRec4ub(8, 4, 0, 0);
  2769. {$IFNDEF OPENGL_ES}
  2770. fOpenGLFormat := tfXRGB4us1;
  2771. fglFormat := GL_BGRA;
  2772. fglInternalFormat := GL_RGB4;
  2773. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2774. {$ELSE}
  2775. fOpenGLFormat := tfR5G6B5us1;
  2776. {$ENDIF}
  2777. end;
  2778. procedure TfdR5G6B5us1.SetValues;
  2779. begin
  2780. inherited SetValues;
  2781. fBitsPerPixel := 16;
  2782. fFormat := tfR5G6B5us1;
  2783. fWithAlpha := tfRGB5A1us1;
  2784. fWithoutAlpha := tfR5G6B5us1;
  2785. fRGBInverted := tfB5G6R5us1;
  2786. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2787. fShift := glBitmapRec4ub(11, 5, 0, 0);
  2788. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  2789. fOpenGLFormat := tfR5G6B5us1;
  2790. fglFormat := GL_RGB;
  2791. fglInternalFormat := GL_RGB565;
  2792. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2793. {$ELSE}
  2794. fOpenGLFormat := tfRGB8ub3;
  2795. {$IFEND}
  2796. end;
  2797. procedure TfdRGB5X1us1.SetValues;
  2798. begin
  2799. inherited SetValues;
  2800. fBitsPerPixel := 16;
  2801. fFormat := tfRGB5X1us1;
  2802. fWithAlpha := tfRGB5A1us1;
  2803. fWithoutAlpha := tfRGB5X1us1;
  2804. fRGBInverted := tfBGR5X1us1;
  2805. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2806. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2807. {$IFNDEF OPENGL_ES}
  2808. fOpenGLFormat := tfRGB5X1us1;
  2809. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2810. fglInternalFormat := GL_RGB5;
  2811. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2812. {$ELSE}
  2813. fOpenGLFormat := tfR5G6B5us1;
  2814. {$ENDIF}
  2815. end;
  2816. procedure TfdX1RGB5us1.SetValues;
  2817. begin
  2818. inherited SetValues;
  2819. fBitsPerPixel := 16;
  2820. fFormat := tfX1RGB5us1;
  2821. fWithAlpha := tfA1RGB5us1;
  2822. fWithoutAlpha := tfX1RGB5us1;
  2823. fRGBInverted := tfX1BGR5us1;
  2824. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2825. fShift := glBitmapRec4ub(10, 5, 0, 0);
  2826. {$IFNDEF OPENGL_ES}
  2827. fOpenGLFormat := tfX1RGB5us1;
  2828. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2829. fglInternalFormat := GL_RGB5;
  2830. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2831. {$ELSE}
  2832. fOpenGLFormat := tfR5G6B5us1;
  2833. {$ENDIF}
  2834. end;
  2835. procedure TfdRGB8ub3.SetValues;
  2836. begin
  2837. inherited SetValues;
  2838. fBitsPerPixel := 24;
  2839. fFormat := tfRGB8ub3;
  2840. fWithAlpha := tfRGBA8ub4;
  2841. fWithoutAlpha := tfRGB8ub3;
  2842. fRGBInverted := tfBGR8ub3;
  2843. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2844. fShift := glBitmapRec4ub(0, 8, 16, 0);
  2845. fOpenGLFormat := tfRGB8ub3;
  2846. fglFormat := GL_RGB;
  2847. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
  2848. fglDataFormat := GL_UNSIGNED_BYTE;
  2849. end;
  2850. procedure TfdRGBX8ui1.SetValues;
  2851. begin
  2852. inherited SetValues;
  2853. fBitsPerPixel := 32;
  2854. fFormat := tfRGBX8ui1;
  2855. fWithAlpha := tfRGBA8ui1;
  2856. fWithoutAlpha := tfRGBX8ui1;
  2857. fRGBInverted := tfBGRX8ui1;
  2858. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2859. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2860. {$IFNDEF OPENGL_ES}
  2861. fOpenGLFormat := tfRGBX8ui1;
  2862. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2863. fglInternalFormat := GL_RGB8;
  2864. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2865. {$ELSE}
  2866. fOpenGLFormat := tfRGB8ub3;
  2867. {$ENDIF}
  2868. end;
  2869. procedure TfdXRGB8ui1.SetValues;
  2870. begin
  2871. inherited SetValues;
  2872. fBitsPerPixel := 32;
  2873. fFormat := tfXRGB8ui1;
  2874. fWithAlpha := tfXRGB8ui1;
  2875. fWithoutAlpha := tfXRGB8ui1;
  2876. fOpenGLFormat := tfXRGB8ui1;
  2877. fRGBInverted := tfXBGR8ui1;
  2878. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2879. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2880. {$IFNDEF OPENGL_ES}
  2881. fOpenGLFormat := tfXRGB8ui1;
  2882. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2883. fglInternalFormat := GL_RGB8;
  2884. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2885. {$ELSE}
  2886. fOpenGLFormat := tfRGB8ub3;
  2887. {$ENDIF}
  2888. end;
  2889. procedure TfdRGB10X2ui1.SetValues;
  2890. begin
  2891. inherited SetValues;
  2892. fBitsPerPixel := 32;
  2893. fFormat := tfRGB10X2ui1;
  2894. fWithAlpha := tfRGB10A2ui1;
  2895. fWithoutAlpha := tfRGB10X2ui1;
  2896. fRGBInverted := tfBGR10X2ui1;
  2897. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2898. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2899. {$IFNDEF OPENGL_ES}
  2900. fOpenGLFormat := tfRGB10X2ui1;
  2901. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2902. fglInternalFormat := GL_RGB10;
  2903. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2904. {$ELSE}
  2905. fOpenGLFormat := tfRGB16us3;
  2906. {$ENDIF}
  2907. end;
  2908. procedure TfdX2RGB10ui1.SetValues;
  2909. begin
  2910. inherited SetValues;
  2911. fBitsPerPixel := 32;
  2912. fFormat := tfX2RGB10ui1;
  2913. fWithAlpha := tfA2RGB10ui1;
  2914. fWithoutAlpha := tfX2RGB10ui1;
  2915. fRGBInverted := tfX2BGR10ui1;
  2916. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2917. fShift := glBitmapRec4ub(20, 10, 0, 0);
  2918. {$IFNDEF OPENGL_ES}
  2919. fOpenGLFormat := tfX2RGB10ui1;
  2920. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2921. fglInternalFormat := GL_RGB10;
  2922. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2923. {$ELSE}
  2924. fOpenGLFormat := tfRGB16us3;
  2925. {$ENDIF}
  2926. end;
  2927. procedure TfdRGB16us3.SetValues;
  2928. begin
  2929. inherited SetValues;
  2930. fBitsPerPixel := 48;
  2931. fFormat := tfRGB16us3;
  2932. fWithAlpha := tfRGBA16us4;
  2933. fWithoutAlpha := tfRGB16us3;
  2934. fRGBInverted := tfBGR16us3;
  2935. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2936. fShift := glBitmapRec4ub( 0, 16, 32, 0);
  2937. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2938. fOpenGLFormat := tfRGB16us3;
  2939. fglFormat := GL_RGB;
  2940. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
  2941. fglDataFormat := GL_UNSIGNED_SHORT;
  2942. {$ELSE}
  2943. fOpenGLFormat := tfRGB8ub3;
  2944. {$IFEND}
  2945. end;
  2946. procedure TfdRGBA4us1.SetValues;
  2947. begin
  2948. inherited SetValues;
  2949. fBitsPerPixel := 16;
  2950. fFormat := tfRGBA4us1;
  2951. fWithAlpha := tfRGBA4us1;
  2952. fWithoutAlpha := tfRGBX4us1;
  2953. fOpenGLFormat := tfRGBA4us1;
  2954. fRGBInverted := tfBGRA4us1;
  2955. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2956. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2957. fglFormat := GL_RGBA;
  2958. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2959. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2960. end;
  2961. procedure TfdARGB4us1.SetValues;
  2962. begin
  2963. inherited SetValues;
  2964. fBitsPerPixel := 16;
  2965. fFormat := tfARGB4us1;
  2966. fWithAlpha := tfARGB4us1;
  2967. fWithoutAlpha := tfXRGB4us1;
  2968. fRGBInverted := tfABGR4us1;
  2969. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2970. fShift := glBitmapRec4ub( 8, 4, 0, 12);
  2971. {$IFNDEF OPENGL_ES}
  2972. fOpenGLFormat := tfARGB4us1;
  2973. fglFormat := GL_BGRA;
  2974. fglInternalFormat := GL_RGBA4;
  2975. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2976. {$ELSE}
  2977. fOpenGLFormat := tfRGBA4us1;
  2978. {$ENDIF}
  2979. end;
  2980. procedure TfdRGB5A1us1.SetValues;
  2981. begin
  2982. inherited SetValues;
  2983. fBitsPerPixel := 16;
  2984. fFormat := tfRGB5A1us1;
  2985. fWithAlpha := tfRGB5A1us1;
  2986. fWithoutAlpha := tfRGB5X1us1;
  2987. fOpenGLFormat := tfRGB5A1us1;
  2988. fRGBInverted := tfBGR5A1us1;
  2989. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2990. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2991. fglFormat := GL_RGBA;
  2992. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
  2993. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2994. end;
  2995. procedure TfdA1RGB5us1.SetValues;
  2996. begin
  2997. inherited SetValues;
  2998. fBitsPerPixel := 16;
  2999. fFormat := tfA1RGB5us1;
  3000. fWithAlpha := tfA1RGB5us1;
  3001. fWithoutAlpha := tfX1RGB5us1;
  3002. fRGBInverted := tfA1BGR5us1;
  3003. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3004. fShift := glBitmapRec4ub(10, 5, 0, 15);
  3005. {$IFNDEF OPENGL_ES}
  3006. fOpenGLFormat := tfA1RGB5us1;
  3007. fglFormat := GL_BGRA;
  3008. fglInternalFormat := GL_RGB5_A1;
  3009. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3010. {$ELSE}
  3011. fOpenGLFormat := tfRGB5A1us1;
  3012. {$ENDIF}
  3013. end;
  3014. procedure TfdRGBA8ui1.SetValues;
  3015. begin
  3016. inherited SetValues;
  3017. fBitsPerPixel := 32;
  3018. fFormat := tfRGBA8ui1;
  3019. fWithAlpha := tfRGBA8ui1;
  3020. fWithoutAlpha := tfRGBX8ui1;
  3021. fRGBInverted := tfBGRA8ui1;
  3022. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3023. fShift := glBitmapRec4ub(24, 16, 8, 0);
  3024. {$IFNDEF OPENGL_ES}
  3025. fOpenGLFormat := tfRGBA8ui1;
  3026. fglFormat := GL_RGBA;
  3027. fglInternalFormat := GL_RGBA8;
  3028. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3029. {$ELSE}
  3030. fOpenGLFormat := tfRGBA8ub4;
  3031. {$ENDIF}
  3032. end;
  3033. procedure TfdARGB8ui1.SetValues;
  3034. begin
  3035. inherited SetValues;
  3036. fBitsPerPixel := 32;
  3037. fFormat := tfARGB8ui1;
  3038. fWithAlpha := tfARGB8ui1;
  3039. fWithoutAlpha := tfXRGB8ui1;
  3040. fRGBInverted := tfABGR8ui1;
  3041. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3042. fShift := glBitmapRec4ub(16, 8, 0, 24);
  3043. {$IFNDEF OPENGL_ES}
  3044. fOpenGLFormat := tfARGB8ui1;
  3045. fglFormat := GL_BGRA;
  3046. fglInternalFormat := GL_RGBA8;
  3047. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3048. {$ELSE}
  3049. fOpenGLFormat := tfRGBA8ub4;
  3050. {$ENDIF}
  3051. end;
  3052. procedure TfdRGBA8ub4.SetValues;
  3053. begin
  3054. inherited SetValues;
  3055. fBitsPerPixel := 32;
  3056. fFormat := tfRGBA8ub4;
  3057. fWithAlpha := tfRGBA8ub4;
  3058. fWithoutAlpha := tfRGB8ub3;
  3059. fOpenGLFormat := tfRGBA8ub4;
  3060. fRGBInverted := tfBGRA8ub4;
  3061. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3062. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  3063. fglFormat := GL_RGBA;
  3064. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  3065. fglDataFormat := GL_UNSIGNED_BYTE;
  3066. end;
  3067. procedure TfdRGB10A2ui1.SetValues;
  3068. begin
  3069. inherited SetValues;
  3070. fBitsPerPixel := 32;
  3071. fFormat := tfRGB10A2ui1;
  3072. fWithAlpha := tfRGB10A2ui1;
  3073. fWithoutAlpha := tfRGB10X2ui1;
  3074. fRGBInverted := tfBGR10A2ui1;
  3075. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3076. fShift := glBitmapRec4ub(22, 12, 2, 0);
  3077. {$IFNDEF OPENGL_ES}
  3078. fOpenGLFormat := tfRGB10A2ui1;
  3079. fglFormat := GL_RGBA;
  3080. fglInternalFormat := GL_RGB10_A2;
  3081. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3082. {$ELSE}
  3083. fOpenGLFormat := tfA2RGB10ui1;
  3084. {$ENDIF}
  3085. end;
  3086. procedure TfdA2RGB10ui1.SetValues;
  3087. begin
  3088. inherited SetValues;
  3089. fBitsPerPixel := 32;
  3090. fFormat := tfA2RGB10ui1;
  3091. fWithAlpha := tfA2RGB10ui1;
  3092. fWithoutAlpha := tfX2RGB10ui1;
  3093. fRGBInverted := tfA2BGR10ui1;
  3094. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3095. fShift := glBitmapRec4ub(20, 10, 0, 30);
  3096. {$IF NOT DEFINED(OPENGL_ES)}
  3097. fOpenGLFormat := tfA2RGB10ui1;
  3098. fglFormat := GL_BGRA;
  3099. fglInternalFormat := GL_RGB10_A2;
  3100. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3101. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  3102. fOpenGLFormat := tfA2RGB10ui1;
  3103. fglFormat := GL_RGBA;
  3104. fglInternalFormat := GL_RGB10_A2;
  3105. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3106. {$ELSE}
  3107. fOpenGLFormat := tfRGBA8ui1;
  3108. {$IFEND}
  3109. end;
  3110. procedure TfdRGBA16us4.SetValues;
  3111. begin
  3112. inherited SetValues;
  3113. fBitsPerPixel := 64;
  3114. fFormat := tfRGBA16us4;
  3115. fWithAlpha := tfRGBA16us4;
  3116. fWithoutAlpha := tfRGB16us3;
  3117. fRGBInverted := tfBGRA16us4;
  3118. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3119. fShift := glBitmapRec4ub( 0, 16, 32, 48);
  3120. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  3121. fOpenGLFormat := tfRGBA16us4;
  3122. fglFormat := GL_RGBA;
  3123. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
  3124. fglDataFormat := GL_UNSIGNED_SHORT;
  3125. {$ELSE}
  3126. fOpenGLFormat := tfRGBA8ub4;
  3127. {$IFEND}
  3128. end;
  3129. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3131. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3132. procedure TfdBGRX4us1.SetValues;
  3133. begin
  3134. inherited SetValues;
  3135. fBitsPerPixel := 16;
  3136. fFormat := tfBGRX4us1;
  3137. fWithAlpha := tfBGRA4us1;
  3138. fWithoutAlpha := tfBGRX4us1;
  3139. fRGBInverted := tfRGBX4us1;
  3140. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  3141. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  3142. {$IFNDEF OPENGL_ES}
  3143. fOpenGLFormat := tfBGRX4us1;
  3144. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3145. fglInternalFormat := GL_RGB4;
  3146. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3147. {$ELSE}
  3148. fOpenGLFormat := tfR5G6B5us1;
  3149. {$ENDIF}
  3150. end;
  3151. procedure TfdXBGR4us1.SetValues;
  3152. begin
  3153. inherited SetValues;
  3154. fBitsPerPixel := 16;
  3155. fFormat := tfXBGR4us1;
  3156. fWithAlpha := tfABGR4us1;
  3157. fWithoutAlpha := tfXBGR4us1;
  3158. fRGBInverted := tfXRGB4us1;
  3159. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  3160. fShift := glBitmapRec4ub( 0, 4, 8, 0);
  3161. {$IFNDEF OPENGL_ES}
  3162. fOpenGLFormat := tfXBGR4us1;
  3163. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3164. fglInternalFormat := GL_RGB4;
  3165. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3166. {$ELSE}
  3167. fOpenGLFormat := tfR5G6B5us1;
  3168. {$ENDIF}
  3169. end;
  3170. procedure TfdB5G6R5us1.SetValues;
  3171. begin
  3172. inherited SetValues;
  3173. fBitsPerPixel := 16;
  3174. fFormat := tfB5G6R5us1;
  3175. fWithAlpha := tfBGR5A1us1;
  3176. fWithoutAlpha := tfB5G6R5us1;
  3177. fRGBInverted := tfR5G6B5us1;
  3178. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  3179. fShift := glBitmapRec4ub( 0, 5, 11, 0);
  3180. {$IFNDEF OPENGL_ES}
  3181. fOpenGLFormat := tfB5G6R5us1;
  3182. fglFormat := GL_RGB;
  3183. fglInternalFormat := GL_RGB565;
  3184. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  3185. {$ELSE}
  3186. fOpenGLFormat := tfR5G6B5us1;
  3187. {$ENDIF}
  3188. end;
  3189. procedure TfdBGR5X1us1.SetValues;
  3190. begin
  3191. inherited SetValues;
  3192. fBitsPerPixel := 16;
  3193. fFormat := tfBGR5X1us1;
  3194. fWithAlpha := tfBGR5A1us1;
  3195. fWithoutAlpha := tfBGR5X1us1;
  3196. fRGBInverted := tfRGB5X1us1;
  3197. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  3198. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  3199. {$IFNDEF OPENGL_ES}
  3200. fOpenGLFormat := tfBGR5X1us1;
  3201. fglFormat := GL_BGRA;
  3202. fglInternalFormat := GL_RGB5;
  3203. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3204. {$ELSE}
  3205. fOpenGLFormat := tfR5G6B5us1;
  3206. {$ENDIF}
  3207. end;
  3208. procedure TfdX1BGR5us1.SetValues;
  3209. begin
  3210. inherited SetValues;
  3211. fBitsPerPixel := 16;
  3212. fFormat := tfX1BGR5us1;
  3213. fWithAlpha := tfA1BGR5us1;
  3214. fWithoutAlpha := tfX1BGR5us1;
  3215. fRGBInverted := tfX1RGB5us1;
  3216. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  3217. fShift := glBitmapRec4ub( 0, 5, 10, 0);
  3218. {$IFNDEF OPENGL_ES}
  3219. fOpenGLFormat := tfX1BGR5us1;
  3220. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3221. fglInternalFormat := GL_RGB5;
  3222. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3223. {$ELSE}
  3224. fOpenGLFormat := tfR5G6B5us1;
  3225. {$ENDIF}
  3226. end;
  3227. procedure TfdBGR8ub3.SetValues;
  3228. begin
  3229. inherited SetValues;
  3230. fBitsPerPixel := 24;
  3231. fFormat := tfBGR8ub3;
  3232. fWithAlpha := tfBGRA8ub4;
  3233. fWithoutAlpha := tfBGR8ub3;
  3234. fRGBInverted := tfRGB8ub3;
  3235. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  3236. fShift := glBitmapRec4ub(16, 8, 0, 0);
  3237. {$IFNDEF OPENGL_ES}
  3238. fOpenGLFormat := tfBGR8ub3;
  3239. fglFormat := GL_BGR;
  3240. fglInternalFormat := GL_RGB8;
  3241. fglDataFormat := GL_UNSIGNED_BYTE;
  3242. {$ELSE}
  3243. fOpenGLFormat := tfRGB8ub3;
  3244. {$ENDIF}
  3245. end;
  3246. procedure TfdBGRX8ui1.SetValues;
  3247. begin
  3248. inherited SetValues;
  3249. fBitsPerPixel := 32;
  3250. fFormat := tfBGRX8ui1;
  3251. fWithAlpha := tfBGRA8ui1;
  3252. fWithoutAlpha := tfBGRX8ui1;
  3253. fRGBInverted := tfRGBX8ui1;
  3254. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  3255. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  3256. {$IFNDEF OPENGL_ES}
  3257. fOpenGLFormat := tfBGRX8ui1;
  3258. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3259. fglInternalFormat := GL_RGB8;
  3260. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3261. {$ELSE}
  3262. fOpenGLFormat := tfRGB8ub3;
  3263. {$ENDIF}
  3264. end;
  3265. procedure TfdXBGR8ui1.SetValues;
  3266. begin
  3267. inherited SetValues;
  3268. fBitsPerPixel := 32;
  3269. fFormat := tfXBGR8ui1;
  3270. fWithAlpha := tfABGR8ui1;
  3271. fWithoutAlpha := tfXBGR8ui1;
  3272. fRGBInverted := tfXRGB8ui1;
  3273. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  3274. fShift := glBitmapRec4ub( 0, 8, 16, 0);
  3275. {$IFNDEF OPENGL_ES}
  3276. fOpenGLFormat := tfXBGR8ui1;
  3277. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3278. fglInternalFormat := GL_RGB8;
  3279. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3280. {$ELSE}
  3281. fOpenGLFormat := tfRGB8ub3;
  3282. {$ENDIF}
  3283. end;
  3284. procedure TfdBGR10X2ui1.SetValues;
  3285. begin
  3286. inherited SetValues;
  3287. fBitsPerPixel := 32;
  3288. fFormat := tfBGR10X2ui1;
  3289. fWithAlpha := tfBGR10A2ui1;
  3290. fWithoutAlpha := tfBGR10X2ui1;
  3291. fRGBInverted := tfRGB10X2ui1;
  3292. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  3293. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  3294. {$IFNDEF OPENGL_ES}
  3295. fOpenGLFormat := tfBGR10X2ui1;
  3296. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3297. fglInternalFormat := GL_RGB10;
  3298. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3299. {$ELSE}
  3300. fOpenGLFormat := tfRGB16us3;
  3301. {$ENDIF}
  3302. end;
  3303. procedure TfdX2BGR10ui1.SetValues;
  3304. begin
  3305. inherited SetValues;
  3306. fBitsPerPixel := 32;
  3307. fFormat := tfX2BGR10ui1;
  3308. fWithAlpha := tfA2BGR10ui1;
  3309. fWithoutAlpha := tfX2BGR10ui1;
  3310. fRGBInverted := tfX2RGB10ui1;
  3311. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  3312. fShift := glBitmapRec4ub( 0, 10, 20, 0);
  3313. {$IFNDEF OPENGL_ES}
  3314. fOpenGLFormat := tfX2BGR10ui1;
  3315. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3316. fglInternalFormat := GL_RGB10;
  3317. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3318. {$ELSE}
  3319. fOpenGLFormat := tfRGB16us3;
  3320. {$ENDIF}
  3321. end;
  3322. procedure TfdBGR16us3.SetValues;
  3323. begin
  3324. inherited SetValues;
  3325. fBitsPerPixel := 48;
  3326. fFormat := tfBGR16us3;
  3327. fWithAlpha := tfBGRA16us4;
  3328. fWithoutAlpha := tfBGR16us3;
  3329. fRGBInverted := tfRGB16us3;
  3330. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  3331. fShift := glBitmapRec4ub(32, 16, 0, 0);
  3332. {$IFNDEF OPENGL_ES}
  3333. fOpenGLFormat := tfBGR16us3;
  3334. fglFormat := GL_BGR;
  3335. fglInternalFormat := GL_RGB16;
  3336. fglDataFormat := GL_UNSIGNED_SHORT;
  3337. {$ELSE}
  3338. fOpenGLFormat := tfRGB16us3;
  3339. {$ENDIF}
  3340. end;
  3341. procedure TfdBGRA4us1.SetValues;
  3342. begin
  3343. inherited SetValues;
  3344. fBitsPerPixel := 16;
  3345. fFormat := tfBGRA4us1;
  3346. fWithAlpha := tfBGRA4us1;
  3347. fWithoutAlpha := tfBGRX4us1;
  3348. fRGBInverted := tfRGBA4us1;
  3349. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3350. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  3351. {$IFNDEF OPENGL_ES}
  3352. fOpenGLFormat := tfBGRA4us1;
  3353. fglFormat := GL_BGRA;
  3354. fglInternalFormat := GL_RGBA4;
  3355. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3356. {$ELSE}
  3357. fOpenGLFormat := tfRGBA4us1;
  3358. {$ENDIF}
  3359. end;
  3360. procedure TfdABGR4us1.SetValues;
  3361. begin
  3362. inherited SetValues;
  3363. fBitsPerPixel := 16;
  3364. fFormat := tfABGR4us1;
  3365. fWithAlpha := tfABGR4us1;
  3366. fWithoutAlpha := tfXBGR4us1;
  3367. fRGBInverted := tfARGB4us1;
  3368. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3369. fShift := glBitmapRec4ub( 0, 4, 8, 12);
  3370. {$IFNDEF OPENGL_ES}
  3371. fOpenGLFormat := tfABGR4us1;
  3372. fglFormat := GL_RGBA;
  3373. fglInternalFormat := GL_RGBA4;
  3374. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3375. {$ELSE}
  3376. fOpenGLFormat := tfRGBA4us1;
  3377. {$ENDIF}
  3378. end;
  3379. procedure TfdBGR5A1us1.SetValues;
  3380. begin
  3381. inherited SetValues;
  3382. fBitsPerPixel := 16;
  3383. fFormat := tfBGR5A1us1;
  3384. fWithAlpha := tfBGR5A1us1;
  3385. fWithoutAlpha := tfBGR5X1us1;
  3386. fRGBInverted := tfRGB5A1us1;
  3387. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3388. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  3389. {$IFNDEF OPENGL_ES}
  3390. fOpenGLFormat := tfBGR5A1us1;
  3391. fglFormat := GL_BGRA;
  3392. fglInternalFormat := GL_RGB5_A1;
  3393. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3394. {$ELSE}
  3395. fOpenGLFormat := tfRGB5A1us1;
  3396. {$ENDIF}
  3397. end;
  3398. procedure TfdA1BGR5us1.SetValues;
  3399. begin
  3400. inherited SetValues;
  3401. fBitsPerPixel := 16;
  3402. fFormat := tfA1BGR5us1;
  3403. fWithAlpha := tfA1BGR5us1;
  3404. fWithoutAlpha := tfX1BGR5us1;
  3405. fRGBInverted := tfA1RGB5us1;
  3406. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3407. fShift := glBitmapRec4ub( 0, 5, 10, 15);
  3408. {$IFNDEF OPENGL_ES}
  3409. fOpenGLFormat := tfA1BGR5us1;
  3410. fglFormat := GL_RGBA;
  3411. fglInternalFormat := GL_RGB5_A1;
  3412. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3413. {$ELSE}
  3414. fOpenGLFormat := tfRGB5A1us1;
  3415. {$ENDIF}
  3416. end;
  3417. procedure TfdBGRA8ui1.SetValues;
  3418. begin
  3419. inherited SetValues;
  3420. fBitsPerPixel := 32;
  3421. fFormat := tfBGRA8ui1;
  3422. fWithAlpha := tfBGRA8ui1;
  3423. fWithoutAlpha := tfBGRX8ui1;
  3424. fRGBInverted := tfRGBA8ui1;
  3425. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3426. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  3427. {$IFNDEF OPENGL_ES}
  3428. fOpenGLFormat := tfBGRA8ui1;
  3429. fglFormat := GL_BGRA;
  3430. fglInternalFormat := GL_RGBA8;
  3431. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3432. {$ELSE}
  3433. fOpenGLFormat := tfRGBA8ub4;
  3434. {$ENDIF}
  3435. end;
  3436. procedure TfdABGR8ui1.SetValues;
  3437. begin
  3438. inherited SetValues;
  3439. fBitsPerPixel := 32;
  3440. fFormat := tfABGR8ui1;
  3441. fWithAlpha := tfABGR8ui1;
  3442. fWithoutAlpha := tfXBGR8ui1;
  3443. fRGBInverted := tfARGB8ui1;
  3444. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3445. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  3446. {$IFNDEF OPENGL_ES}
  3447. fOpenGLFormat := tfABGR8ui1;
  3448. fglFormat := GL_RGBA;
  3449. fglInternalFormat := GL_RGBA8;
  3450. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3451. {$ELSE}
  3452. fOpenGLFormat := tfRGBA8ub4
  3453. {$ENDIF}
  3454. end;
  3455. procedure TfdBGRA8ub4.SetValues;
  3456. begin
  3457. inherited SetValues;
  3458. fBitsPerPixel := 32;
  3459. fFormat := tfBGRA8ub4;
  3460. fWithAlpha := tfBGRA8ub4;
  3461. fWithoutAlpha := tfBGR8ub3;
  3462. fRGBInverted := tfRGBA8ub4;
  3463. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3464. fShift := glBitmapRec4ub(16, 8, 0, 24);
  3465. {$IFNDEF OPENGL_ES}
  3466. fOpenGLFormat := tfBGRA8ub4;
  3467. fglFormat := GL_BGRA;
  3468. fglInternalFormat := GL_RGBA8;
  3469. fglDataFormat := GL_UNSIGNED_BYTE;
  3470. {$ELSE}
  3471. fOpenGLFormat := tfRGBA8ub4;
  3472. {$ENDIF}
  3473. end;
  3474. procedure TfdBGR10A2ui1.SetValues;
  3475. begin
  3476. inherited SetValues;
  3477. fBitsPerPixel := 32;
  3478. fFormat := tfBGR10A2ui1;
  3479. fWithAlpha := tfBGR10A2ui1;
  3480. fWithoutAlpha := tfBGR10X2ui1;
  3481. fRGBInverted := tfRGB10A2ui1;
  3482. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3483. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  3484. {$IFNDEF OPENGL_ES}
  3485. fOpenGLFormat := tfBGR10A2ui1;
  3486. fglFormat := GL_BGRA;
  3487. fglInternalFormat := GL_RGB10_A2;
  3488. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3489. {$ELSE}
  3490. fOpenGLFormat := tfA2RGB10ui1;
  3491. {$ENDIF}
  3492. end;
  3493. procedure TfdA2BGR10ui1.SetValues;
  3494. begin
  3495. inherited SetValues;
  3496. fBitsPerPixel := 32;
  3497. fFormat := tfA2BGR10ui1;
  3498. fWithAlpha := tfA2BGR10ui1;
  3499. fWithoutAlpha := tfX2BGR10ui1;
  3500. fRGBInverted := tfA2RGB10ui1;
  3501. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3502. fShift := glBitmapRec4ub( 0, 10, 20, 30);
  3503. {$IFNDEF OPENGL_ES}
  3504. fOpenGLFormat := tfA2BGR10ui1;
  3505. fglFormat := GL_RGBA;
  3506. fglInternalFormat := GL_RGB10_A2;
  3507. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3508. {$ELSE}
  3509. fOpenGLFormat := tfA2RGB10ui1;
  3510. {$ENDIF}
  3511. end;
  3512. procedure TfdBGRA16us4.SetValues;
  3513. begin
  3514. inherited SetValues;
  3515. fBitsPerPixel := 64;
  3516. fFormat := tfBGRA16us4;
  3517. fWithAlpha := tfBGRA16us4;
  3518. fWithoutAlpha := tfBGR16us3;
  3519. fRGBInverted := tfRGBA16us4;
  3520. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3521. fShift := glBitmapRec4ub(32, 16, 0, 48);
  3522. {$IFNDEF OPENGL_ES}
  3523. fOpenGLFormat := tfBGRA16us4;
  3524. fglFormat := GL_BGRA;
  3525. fglInternalFormat := GL_RGBA16;
  3526. fglDataFormat := GL_UNSIGNED_SHORT;
  3527. {$ELSE}
  3528. fOpenGLFormat := tfRGBA16us4;
  3529. {$ENDIF}
  3530. end;
  3531. procedure TfdDepth16us1.SetValues;
  3532. begin
  3533. inherited SetValues;
  3534. fBitsPerPixel := 16;
  3535. fFormat := tfDepth16us1;
  3536. fWithoutAlpha := tfDepth16us1;
  3537. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3538. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3539. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  3540. fOpenGLFormat := tfDepth16us1;
  3541. fglFormat := GL_DEPTH_COMPONENT;
  3542. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3543. fglDataFormat := GL_UNSIGNED_SHORT;
  3544. {$IFEND}
  3545. end;
  3546. procedure TfdDepth24ui1.SetValues;
  3547. begin
  3548. inherited SetValues;
  3549. fBitsPerPixel := 32;
  3550. fFormat := tfDepth24ui1;
  3551. fWithoutAlpha := tfDepth24ui1;
  3552. fOpenGLFormat := tfDepth24ui1;
  3553. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3554. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3555. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  3556. fOpenGLFormat := tfDepth24ui1;
  3557. fglFormat := GL_DEPTH_COMPONENT;
  3558. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3559. fglDataFormat := GL_UNSIGNED_INT;
  3560. {$IFEND}
  3561. end;
  3562. procedure TfdDepth32ui1.SetValues;
  3563. begin
  3564. inherited SetValues;
  3565. fBitsPerPixel := 32;
  3566. fFormat := tfDepth32ui1;
  3567. fWithoutAlpha := tfDepth32ui1;
  3568. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3569. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3570. {$IF NOT DEFINED(OPENGL_ES)}
  3571. fOpenGLFormat := tfDepth32ui1;
  3572. fglFormat := GL_DEPTH_COMPONENT;
  3573. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3574. fglDataFormat := GL_UNSIGNED_INT;
  3575. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  3576. fOpenGLFormat := tfDepth24ui1;
  3577. {$ELSEIF DEFINED(OPENGL_ES_2_0)}
  3578. fOpenGLFormat := tfDepth16us1;
  3579. {$IFEND}
  3580. end;
  3581. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3582. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3583. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3584. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3585. begin
  3586. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3587. end;
  3588. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3589. begin
  3590. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3591. end;
  3592. procedure TfdS3tcDtx1RGBA.SetValues;
  3593. begin
  3594. inherited SetValues;
  3595. fFormat := tfS3tcDtx1RGBA;
  3596. fWithAlpha := tfS3tcDtx1RGBA;
  3597. fUncompressed := tfRGB5A1us1;
  3598. fBitsPerPixel := 4;
  3599. fIsCompressed := true;
  3600. {$IFNDEF OPENGL_ES}
  3601. fOpenGLFormat := tfS3tcDtx1RGBA;
  3602. fglFormat := GL_COMPRESSED_RGBA;
  3603. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3604. fglDataFormat := GL_UNSIGNED_BYTE;
  3605. {$ELSE}
  3606. fOpenGLFormat := fUncompressed;
  3607. {$ENDIF}
  3608. end;
  3609. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3610. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3611. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3612. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3613. begin
  3614. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3615. end;
  3616. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3617. begin
  3618. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3619. end;
  3620. procedure TfdS3tcDtx3RGBA.SetValues;
  3621. begin
  3622. inherited SetValues;
  3623. fFormat := tfS3tcDtx3RGBA;
  3624. fWithAlpha := tfS3tcDtx3RGBA;
  3625. fUncompressed := tfRGBA8ub4;
  3626. fBitsPerPixel := 8;
  3627. fIsCompressed := true;
  3628. {$IFNDEF OPENGL_ES}
  3629. fOpenGLFormat := tfS3tcDtx3RGBA;
  3630. fglFormat := GL_COMPRESSED_RGBA;
  3631. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3632. fglDataFormat := GL_UNSIGNED_BYTE;
  3633. {$ELSE}
  3634. fOpenGLFormat := fUncompressed;
  3635. {$ENDIF}
  3636. end;
  3637. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3638. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3639. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3640. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3641. begin
  3642. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3643. end;
  3644. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3645. begin
  3646. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3647. end;
  3648. procedure TfdS3tcDtx5RGBA.SetValues;
  3649. begin
  3650. inherited SetValues;
  3651. fFormat := tfS3tcDtx3RGBA;
  3652. fWithAlpha := tfS3tcDtx3RGBA;
  3653. fUncompressed := tfRGBA8ub4;
  3654. fBitsPerPixel := 8;
  3655. fIsCompressed := true;
  3656. {$IFNDEF OPENGL_ES}
  3657. fOpenGLFormat := tfS3tcDtx3RGBA;
  3658. fglFormat := GL_COMPRESSED_RGBA;
  3659. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3660. fglDataFormat := GL_UNSIGNED_BYTE;
  3661. {$ELSE}
  3662. fOpenGLFormat := fUncompressed;
  3663. {$ENDIF}
  3664. end;
  3665. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3666. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3667. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3668. function TglBitmapFormatDescriptor.GetHasRed: Boolean;
  3669. begin
  3670. result := (fPrecision.r > 0);
  3671. end;
  3672. function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
  3673. begin
  3674. result := (fPrecision.g > 0);
  3675. end;
  3676. function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
  3677. begin
  3678. result := (fPrecision.b > 0);
  3679. end;
  3680. function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
  3681. begin
  3682. result := (fPrecision.a > 0);
  3683. end;
  3684. function TglBitmapFormatDescriptor.GetHasColor: Boolean;
  3685. begin
  3686. result := HasRed or HasGreen or HasBlue;
  3687. end;
  3688. function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
  3689. begin
  3690. result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
  3691. end;
  3692. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3693. procedure TglBitmapFormatDescriptor.SetValues;
  3694. begin
  3695. fFormat := tfEmpty;
  3696. fWithAlpha := tfEmpty;
  3697. fWithoutAlpha := tfEmpty;
  3698. fOpenGLFormat := tfEmpty;
  3699. fRGBInverted := tfEmpty;
  3700. fUncompressed := tfEmpty;
  3701. fBitsPerPixel := 0;
  3702. fIsCompressed := false;
  3703. fglFormat := 0;
  3704. fglInternalFormat := 0;
  3705. fglDataFormat := 0;
  3706. FillChar(fPrecision, 0, SizeOf(fPrecision));
  3707. FillChar(fShift, 0, SizeOf(fShift));
  3708. end;
  3709. procedure TglBitmapFormatDescriptor.CalcValues;
  3710. var
  3711. i: Integer;
  3712. begin
  3713. fBytesPerPixel := fBitsPerPixel / 8;
  3714. fChannelCount := 0;
  3715. for i := 0 to 3 do begin
  3716. if (fPrecision.arr[i] > 0) then
  3717. inc(fChannelCount);
  3718. fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
  3719. fMask.arr[i] := fRange.arr[i] shl fShift.arr[i];
  3720. end;
  3721. end;
  3722. constructor TglBitmapFormatDescriptor.Create;
  3723. begin
  3724. inherited Create;
  3725. SetValues;
  3726. CalcValues;
  3727. end;
  3728. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3729. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3730. var
  3731. f: TglBitmapFormat;
  3732. begin
  3733. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3734. result := TFormatDescriptor.Get(f);
  3735. if (result.glInternalFormat = aInternalFormat) then
  3736. exit;
  3737. end;
  3738. result := TFormatDescriptor.Get(tfEmpty);
  3739. end;
  3740. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3741. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3742. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3743. class procedure TFormatDescriptor.Init;
  3744. begin
  3745. if not Assigned(FormatDescriptorCS) then
  3746. FormatDescriptorCS := TCriticalSection.Create;
  3747. end;
  3748. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3749. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3750. begin
  3751. FormatDescriptorCS.Enter;
  3752. try
  3753. result := FormatDescriptors[aFormat];
  3754. if not Assigned(result) then begin
  3755. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3756. FormatDescriptors[aFormat] := result;
  3757. end;
  3758. finally
  3759. FormatDescriptorCS.Leave;
  3760. end;
  3761. end;
  3762. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3763. class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3764. begin
  3765. result := Get(Get(aFormat).WithAlpha);
  3766. end;
  3767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3768. class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
  3769. var
  3770. ft: TglBitmapFormat;
  3771. begin
  3772. // find matching format with OpenGL support
  3773. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3774. result := Get(ft);
  3775. if (result.MaskMatch(aMask)) and
  3776. (result.glFormat <> 0) and
  3777. (result.glInternalFormat <> 0) and
  3778. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3779. then
  3780. exit;
  3781. end;
  3782. // find matching format without OpenGL Support
  3783. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3784. result := Get(ft);
  3785. if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3786. exit;
  3787. end;
  3788. result := TFormatDescriptor.Get(tfEmpty);
  3789. end;
  3790. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3791. class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  3792. var
  3793. ft: TglBitmapFormat;
  3794. begin
  3795. // find matching format with OpenGL support
  3796. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3797. result := Get(ft);
  3798. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3799. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3800. (result.glFormat <> 0) and
  3801. (result.glInternalFormat <> 0) and
  3802. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3803. then
  3804. exit;
  3805. end;
  3806. // find matching format without OpenGL Support
  3807. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3808. result := Get(ft);
  3809. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3810. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3811. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3812. exit;
  3813. end;
  3814. result := TFormatDescriptor.Get(tfEmpty);
  3815. end;
  3816. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3817. class procedure TFormatDescriptor.Clear;
  3818. var
  3819. f: TglBitmapFormat;
  3820. begin
  3821. FormatDescriptorCS.Enter;
  3822. try
  3823. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3824. FreeAndNil(FormatDescriptors[f]);
  3825. finally
  3826. FormatDescriptorCS.Leave;
  3827. end;
  3828. end;
  3829. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3830. class procedure TFormatDescriptor.Finalize;
  3831. begin
  3832. Clear;
  3833. FreeAndNil(FormatDescriptorCS);
  3834. end;
  3835. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3836. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3837. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3838. procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
  3839. var
  3840. i: Integer;
  3841. begin
  3842. for i := 0 to 3 do begin
  3843. fShift.arr[i] := 0;
  3844. while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin
  3845. aMask.arr[i] := aMask.arr[i] shr 1;
  3846. inc(fShift.arr[i]);
  3847. end;
  3848. fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
  3849. end;
  3850. CalcValues;
  3851. end;
  3852. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3853. procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3854. begin
  3855. fBitsPerPixel := aBBP;
  3856. fPrecision := aPrec;
  3857. fShift := aShift;
  3858. CalcValues;
  3859. end;
  3860. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3861. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3862. var
  3863. data: QWord;
  3864. begin
  3865. data :=
  3866. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3867. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3868. ((aPixel.Data.b and Range.b) shl Shift.b) or
  3869. ((aPixel.Data.a and Range.a) shl Shift.a);
  3870. case BitsPerPixel of
  3871. 8: aData^ := data;
  3872. 16: PWord(aData)^ := data;
  3873. 32: PCardinal(aData)^ := data;
  3874. 64: PQWord(aData)^ := data;
  3875. else
  3876. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3877. end;
  3878. inc(aData, Round(BytesPerPixel));
  3879. end;
  3880. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3881. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3882. var
  3883. data: QWord;
  3884. i: Integer;
  3885. begin
  3886. case BitsPerPixel of
  3887. 8: data := aData^;
  3888. 16: data := PWord(aData)^;
  3889. 32: data := PCardinal(aData)^;
  3890. 64: data := PQWord(aData)^;
  3891. else
  3892. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3893. end;
  3894. for i := 0 to 3 do
  3895. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
  3896. inc(aData, Round(BytesPerPixel));
  3897. end;
  3898. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3899. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3900. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3901. procedure TbmpColorTableFormat.SetValues;
  3902. begin
  3903. inherited SetValues;
  3904. fShift := glBitmapRec4ub(8, 8, 8, 0);
  3905. end;
  3906. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3907. procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3908. begin
  3909. fFormat := aFormat;
  3910. fBitsPerPixel := aBPP;
  3911. fPrecision := aPrec;
  3912. fShift := aShift;
  3913. CalcValues;
  3914. end;
  3915. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3916. procedure TbmpColorTableFormat.CalcValues;
  3917. begin
  3918. inherited CalcValues;
  3919. end;
  3920. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3921. procedure TbmpColorTableFormat.CreateColorTable;
  3922. var
  3923. i: Integer;
  3924. begin
  3925. SetLength(fColorTable, 256);
  3926. if not HasColor then begin
  3927. // alpha
  3928. for i := 0 to High(fColorTable) do begin
  3929. fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3930. fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3931. fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3932. fColorTable[i].a := 0;
  3933. end;
  3934. end else begin
  3935. // normal
  3936. for i := 0 to High(fColorTable) do begin
  3937. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3938. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3939. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3940. fColorTable[i].a := 0;
  3941. end;
  3942. end;
  3943. end;
  3944. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3945. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3946. begin
  3947. if (BitsPerPixel <> 8) then
  3948. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3949. if not HasColor then
  3950. // alpha
  3951. aData^ := aPixel.Data.a
  3952. else
  3953. // normal
  3954. aData^ := Round(
  3955. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3956. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3957. ((aPixel.Data.b and Range.b) shl Shift.b));
  3958. inc(aData);
  3959. end;
  3960. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3961. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3962. begin
  3963. if (BitsPerPixel <> 8) then
  3964. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3965. with fColorTable[aData^] do begin
  3966. aPixel.Data.r := r;
  3967. aPixel.Data.g := g;
  3968. aPixel.Data.b := b;
  3969. aPixel.Data.a := a;
  3970. end;
  3971. inc(aData, 1);
  3972. end;
  3973. destructor TbmpColorTableFormat.Destroy;
  3974. begin
  3975. SetLength(fColorTable, 0);
  3976. inherited Destroy;
  3977. end;
  3978. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3979. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3981. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3982. var
  3983. i: Integer;
  3984. begin
  3985. for i := 0 to 3 do begin
  3986. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3987. if (aSourceFD.Range.arr[i] > 0) then
  3988. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3989. else
  3990. aPixel.Data.arr[i] := 0;
  3991. end;
  3992. end;
  3993. end;
  3994. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3995. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3996. begin
  3997. with aFuncRec do begin
  3998. if (Source.Range.r > 0) then
  3999. Dest.Data.r := Source.Data.r;
  4000. if (Source.Range.g > 0) then
  4001. Dest.Data.g := Source.Data.g;
  4002. if (Source.Range.b > 0) then
  4003. Dest.Data.b := Source.Data.b;
  4004. if (Source.Range.a > 0) then
  4005. Dest.Data.a := Source.Data.a;
  4006. end;
  4007. end;
  4008. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4009. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  4010. var
  4011. i: Integer;
  4012. begin
  4013. with aFuncRec do begin
  4014. for i := 0 to 3 do
  4015. if (Source.Range.arr[i] > 0) then
  4016. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  4017. end;
  4018. end;
  4019. type
  4020. TShiftData = packed record
  4021. case Integer of
  4022. 0: (r, g, b, a: SmallInt);
  4023. 1: (arr: array[0..3] of SmallInt);
  4024. end;
  4025. PShiftData = ^TShiftData;
  4026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4027. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  4028. var
  4029. i: Integer;
  4030. begin
  4031. with aFuncRec do
  4032. for i := 0 to 3 do
  4033. if (Source.Range.arr[i] > 0) then
  4034. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  4035. end;
  4036. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4037. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  4038. begin
  4039. with aFuncRec do begin
  4040. Dest.Data := Source.Data;
  4041. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  4042. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  4043. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  4044. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  4045. end;
  4046. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  4047. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  4048. end;
  4049. end;
  4050. end;
  4051. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4052. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  4053. var
  4054. i: Integer;
  4055. begin
  4056. with aFuncRec do begin
  4057. for i := 0 to 3 do
  4058. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  4059. end;
  4060. end;
  4061. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4062. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  4063. var
  4064. Temp: Single;
  4065. begin
  4066. with FuncRec do begin
  4067. if (FuncRec.Args = nil) then begin //source has no alpha
  4068. Temp :=
  4069. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  4070. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  4071. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  4072. Dest.Data.a := Round(Dest.Range.a * Temp);
  4073. end else
  4074. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  4075. end;
  4076. end;
  4077. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4078. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  4079. type
  4080. PglBitmapPixelData = ^TglBitmapPixelData;
  4081. begin
  4082. with FuncRec do begin
  4083. Dest.Data.r := Source.Data.r;
  4084. Dest.Data.g := Source.Data.g;
  4085. Dest.Data.b := Source.Data.b;
  4086. with PglBitmapPixelData(Args)^ do
  4087. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  4088. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  4089. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  4090. Dest.Data.a := 0
  4091. else
  4092. Dest.Data.a := Dest.Range.a;
  4093. end;
  4094. end;
  4095. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4096. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  4097. begin
  4098. with FuncRec do begin
  4099. Dest.Data.r := Source.Data.r;
  4100. Dest.Data.g := Source.Data.g;
  4101. Dest.Data.b := Source.Data.b;
  4102. Dest.Data.a := PCardinal(Args)^;
  4103. end;
  4104. end;
  4105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4106. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  4107. type
  4108. PRGBPix = ^TRGBPix;
  4109. TRGBPix = array [0..2] of byte;
  4110. var
  4111. Temp: Byte;
  4112. begin
  4113. while aWidth > 0 do begin
  4114. Temp := PRGBPix(aData)^[0];
  4115. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  4116. PRGBPix(aData)^[2] := Temp;
  4117. if aHasAlpha then
  4118. Inc(aData, 4)
  4119. else
  4120. Inc(aData, 3);
  4121. dec(aWidth);
  4122. end;
  4123. end;
  4124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4125. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4126. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4127. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  4128. begin
  4129. result := TFormatDescriptor.Get(Format);
  4130. end;
  4131. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4132. function TglBitmap.GetWidth: Integer;
  4133. begin
  4134. if (ffX in fDimension.Fields) then
  4135. result := fDimension.X
  4136. else
  4137. result := -1;
  4138. end;
  4139. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4140. function TglBitmap.GetHeight: Integer;
  4141. begin
  4142. if (ffY in fDimension.Fields) then
  4143. result := fDimension.Y
  4144. else
  4145. result := -1;
  4146. end;
  4147. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4148. function TglBitmap.GetFileWidth: Integer;
  4149. begin
  4150. result := Max(1, Width);
  4151. end;
  4152. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4153. function TglBitmap.GetFileHeight: Integer;
  4154. begin
  4155. result := Max(1, Height);
  4156. end;
  4157. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4158. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  4159. begin
  4160. if fCustomData = aValue then
  4161. exit;
  4162. fCustomData := aValue;
  4163. end;
  4164. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4165. procedure TglBitmap.SetCustomName(const aValue: String);
  4166. begin
  4167. if fCustomName = aValue then
  4168. exit;
  4169. fCustomName := aValue;
  4170. end;
  4171. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4172. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  4173. begin
  4174. if fCustomNameW = aValue then
  4175. exit;
  4176. fCustomNameW := aValue;
  4177. end;
  4178. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4179. procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
  4180. begin
  4181. if fFreeDataOnDestroy = aValue then
  4182. exit;
  4183. fFreeDataOnDestroy := aValue;
  4184. end;
  4185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4186. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  4187. begin
  4188. if fDeleteTextureOnFree = aValue then
  4189. exit;
  4190. fDeleteTextureOnFree := aValue;
  4191. end;
  4192. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4193. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  4194. begin
  4195. if fFormat = aValue then
  4196. exit;
  4197. if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
  4198. raise EglBitmapUnsupportedFormat.Create(Format);
  4199. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  4200. end;
  4201. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4202. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  4203. begin
  4204. if fFreeDataAfterGenTexture = aValue then
  4205. exit;
  4206. fFreeDataAfterGenTexture := aValue;
  4207. end;
  4208. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4209. procedure TglBitmap.SetID(const aValue: Cardinal);
  4210. begin
  4211. if fID = aValue then
  4212. exit;
  4213. fID := aValue;
  4214. end;
  4215. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4216. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  4217. begin
  4218. if fMipMap = aValue then
  4219. exit;
  4220. fMipMap := aValue;
  4221. end;
  4222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4223. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  4224. begin
  4225. if fTarget = aValue then
  4226. exit;
  4227. fTarget := aValue;
  4228. end;
  4229. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4230. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  4231. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  4232. var
  4233. MaxAnisotropic: Integer;
  4234. {$IFEND}
  4235. begin
  4236. fAnisotropic := aValue;
  4237. if (ID > 0) then begin
  4238. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  4239. if GL_EXT_texture_filter_anisotropic then begin
  4240. if fAnisotropic > 0 then begin
  4241. Bind(false);
  4242. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  4243. if aValue > MaxAnisotropic then
  4244. fAnisotropic := MaxAnisotropic;
  4245. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  4246. end;
  4247. end else begin
  4248. fAnisotropic := 0;
  4249. end;
  4250. {$ELSE}
  4251. fAnisotropic := 0;
  4252. {$IFEND}
  4253. end;
  4254. end;
  4255. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4256. procedure TglBitmap.CreateID;
  4257. begin
  4258. if (ID <> 0) then
  4259. glDeleteTextures(1, @fID);
  4260. glGenTextures(1, @fID);
  4261. Bind(false);
  4262. end;
  4263. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4264. procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  4265. begin
  4266. // Set Up Parameters
  4267. SetWrap(fWrapS, fWrapT, fWrapR);
  4268. SetFilter(fFilterMin, fFilterMag);
  4269. SetAnisotropic(fAnisotropic);
  4270. {$IFNDEF OPENGL_ES}
  4271. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  4272. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4273. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  4274. {$ENDIF}
  4275. {$IFNDEF OPENGL_ES}
  4276. // Mip Maps Generation Mode
  4277. aBuildWithGlu := false;
  4278. if (MipMap = mmMipmap) then begin
  4279. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  4280. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  4281. else
  4282. aBuildWithGlu := true;
  4283. end else if (MipMap = mmMipmapGlu) then
  4284. aBuildWithGlu := true;
  4285. {$ELSE}
  4286. if (MipMap = mmMipmap) then
  4287. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
  4288. {$ENDIF}
  4289. end;
  4290. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4291. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  4292. const aWidth: Integer; const aHeight: Integer);
  4293. var
  4294. s: Single;
  4295. begin
  4296. if (Data <> aData) then begin
  4297. if (Assigned(Data)) then
  4298. FreeMem(Data);
  4299. fData := aData;
  4300. end;
  4301. if not Assigned(fData) then begin
  4302. fPixelSize := 0;
  4303. fRowSize := 0;
  4304. end else begin
  4305. FillChar(fDimension, SizeOf(fDimension), 0);
  4306. if aWidth <> -1 then begin
  4307. fDimension.Fields := fDimension.Fields + [ffX];
  4308. fDimension.X := aWidth;
  4309. end;
  4310. if aHeight <> -1 then begin
  4311. fDimension.Fields := fDimension.Fields + [ffY];
  4312. fDimension.Y := aHeight;
  4313. end;
  4314. s := TFormatDescriptor.Get(aFormat).BytesPerPixel;
  4315. fFormat := aFormat;
  4316. fPixelSize := Ceil(s);
  4317. fRowSize := Ceil(s * aWidth);
  4318. end;
  4319. end;
  4320. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4321. function TglBitmap.FlipHorz: Boolean;
  4322. begin
  4323. result := false;
  4324. end;
  4325. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4326. function TglBitmap.FlipVert: Boolean;
  4327. begin
  4328. result := false;
  4329. end;
  4330. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4331. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4332. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4333. procedure TglBitmap.AfterConstruction;
  4334. begin
  4335. inherited AfterConstruction;
  4336. fID := 0;
  4337. fTarget := 0;
  4338. {$IFNDEF OPENGL_ES}
  4339. fIsResident := false;
  4340. {$ENDIF}
  4341. fMipMap := glBitmapDefaultMipmap;
  4342. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  4343. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  4344. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  4345. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  4346. {$IFNDEF OPENGL_ES}
  4347. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  4348. {$ENDIF}
  4349. end;
  4350. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4351. procedure TglBitmap.BeforeDestruction;
  4352. var
  4353. NewData: PByte;
  4354. begin
  4355. if fFreeDataOnDestroy then begin
  4356. NewData := nil;
  4357. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  4358. end;
  4359. if (fID > 0) and fDeleteTextureOnFree then
  4360. glDeleteTextures(1, @fID);
  4361. inherited BeforeDestruction;
  4362. end;
  4363. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4364. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  4365. var
  4366. TempPos: Integer;
  4367. begin
  4368. if not Assigned(aResType) then begin
  4369. TempPos := Pos('.', aResource);
  4370. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  4371. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  4372. end;
  4373. end;
  4374. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4375. procedure TglBitmap.LoadFromFile(const aFilename: String);
  4376. var
  4377. fs: TFileStream;
  4378. begin
  4379. if not FileExists(aFilename) then
  4380. raise EglBitmap.Create('file does not exist: ' + aFilename);
  4381. fFilename := aFilename;
  4382. fs := TFileStream.Create(fFilename, fmOpenRead);
  4383. try
  4384. fs.Position := 0;
  4385. LoadFromStream(fs);
  4386. finally
  4387. fs.Free;
  4388. end;
  4389. end;
  4390. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4391. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  4392. begin
  4393. {$IFDEF GLB_SUPPORT_PNG_READ}
  4394. if not LoadPNG(aStream) then
  4395. {$ENDIF}
  4396. {$IFDEF GLB_SUPPORT_JPEG_READ}
  4397. if not LoadJPEG(aStream) then
  4398. {$ENDIF}
  4399. if not LoadDDS(aStream) then
  4400. if not LoadTGA(aStream) then
  4401. if not LoadBMP(aStream) then
  4402. if not LoadRAW(aStream) then
  4403. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  4404. end;
  4405. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4406. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  4407. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  4408. var
  4409. tmpData: PByte;
  4410. size: Integer;
  4411. begin
  4412. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4413. GetMem(tmpData, size);
  4414. try
  4415. FillChar(tmpData^, size, #$FF);
  4416. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4417. except
  4418. if Assigned(tmpData) then
  4419. FreeMem(tmpData);
  4420. raise;
  4421. end;
  4422. AddFunc(Self, aFunc, false, aFormat, aArgs);
  4423. end;
  4424. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4425. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  4426. var
  4427. rs: TResourceStream;
  4428. begin
  4429. PrepareResType(aResource, aResType);
  4430. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4431. try
  4432. LoadFromStream(rs);
  4433. finally
  4434. rs.Free;
  4435. end;
  4436. end;
  4437. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4438. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4439. var
  4440. rs: TResourceStream;
  4441. begin
  4442. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4443. try
  4444. LoadFromStream(rs);
  4445. finally
  4446. rs.Free;
  4447. end;
  4448. end;
  4449. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4450. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  4451. var
  4452. fs: TFileStream;
  4453. begin
  4454. fs := TFileStream.Create(aFileName, fmCreate);
  4455. try
  4456. fs.Position := 0;
  4457. SaveToStream(fs, aFileType);
  4458. finally
  4459. fs.Free;
  4460. end;
  4461. end;
  4462. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4463. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  4464. begin
  4465. case aFileType of
  4466. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4467. ftPNG: SavePNG(aStream);
  4468. {$ENDIF}
  4469. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  4470. ftJPEG: SaveJPEG(aStream);
  4471. {$ENDIF}
  4472. ftDDS: SaveDDS(aStream);
  4473. ftTGA: SaveTGA(aStream);
  4474. ftBMP: SaveBMP(aStream);
  4475. ftRAW: SaveRAW(aStream);
  4476. end;
  4477. end;
  4478. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4479. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  4480. begin
  4481. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  4482. end;
  4483. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4484. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  4485. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  4486. var
  4487. DestData, TmpData, SourceData: pByte;
  4488. TempHeight, TempWidth: Integer;
  4489. SourceFD, DestFD: TFormatDescriptor;
  4490. SourceMD, DestMD: Pointer;
  4491. FuncRec: TglBitmapFunctionRec;
  4492. begin
  4493. Assert(Assigned(Data));
  4494. Assert(Assigned(aSource));
  4495. Assert(Assigned(aSource.Data));
  4496. result := false;
  4497. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  4498. SourceFD := TFormatDescriptor.Get(aSource.Format);
  4499. DestFD := TFormatDescriptor.Get(aFormat);
  4500. if (SourceFD.IsCompressed) then
  4501. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  4502. if (DestFD.IsCompressed) then
  4503. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  4504. // inkompatible Formats so CreateTemp
  4505. if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
  4506. aCreateTemp := true;
  4507. // Values
  4508. TempHeight := Max(1, aSource.Height);
  4509. TempWidth := Max(1, aSource.Width);
  4510. FuncRec.Sender := Self;
  4511. FuncRec.Args := aArgs;
  4512. TmpData := nil;
  4513. if aCreateTemp then begin
  4514. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  4515. DestData := TmpData;
  4516. end else
  4517. DestData := Data;
  4518. try
  4519. SourceFD.PreparePixel(FuncRec.Source);
  4520. DestFD.PreparePixel (FuncRec.Dest);
  4521. SourceMD := SourceFD.CreateMappingData;
  4522. DestMD := DestFD.CreateMappingData;
  4523. FuncRec.Size := aSource.Dimension;
  4524. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4525. try
  4526. SourceData := aSource.Data;
  4527. FuncRec.Position.Y := 0;
  4528. while FuncRec.Position.Y < TempHeight do begin
  4529. FuncRec.Position.X := 0;
  4530. while FuncRec.Position.X < TempWidth do begin
  4531. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4532. aFunc(FuncRec);
  4533. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  4534. inc(FuncRec.Position.X);
  4535. end;
  4536. inc(FuncRec.Position.Y);
  4537. end;
  4538. // Updating Image or InternalFormat
  4539. if aCreateTemp then
  4540. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  4541. else if (aFormat <> fFormat) then
  4542. Format := aFormat;
  4543. result := true;
  4544. finally
  4545. SourceFD.FreeMappingData(SourceMD);
  4546. DestFD.FreeMappingData(DestMD);
  4547. end;
  4548. except
  4549. if aCreateTemp and Assigned(TmpData) then
  4550. FreeMem(TmpData);
  4551. raise;
  4552. end;
  4553. end;
  4554. end;
  4555. {$IFDEF GLB_SDL}
  4556. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4557. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  4558. var
  4559. Row, RowSize: Integer;
  4560. SourceData, TmpData: PByte;
  4561. TempDepth: Integer;
  4562. FormatDesc: TFormatDescriptor;
  4563. function GetRowPointer(Row: Integer): pByte;
  4564. begin
  4565. result := aSurface.pixels;
  4566. Inc(result, Row * RowSize);
  4567. end;
  4568. begin
  4569. result := false;
  4570. FormatDesc := TFormatDescriptor.Get(Format);
  4571. if FormatDesc.IsCompressed then
  4572. raise EglBitmapUnsupportedFormat.Create(Format);
  4573. if Assigned(Data) then begin
  4574. case Trunc(FormatDesc.PixelSize) of
  4575. 1: TempDepth := 8;
  4576. 2: TempDepth := 16;
  4577. 3: TempDepth := 24;
  4578. 4: TempDepth := 32;
  4579. else
  4580. raise EglBitmapUnsupportedFormat.Create(Format);
  4581. end;
  4582. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4583. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4584. SourceData := Data;
  4585. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4586. for Row := 0 to FileHeight-1 do begin
  4587. TmpData := GetRowPointer(Row);
  4588. if Assigned(TmpData) then begin
  4589. Move(SourceData^, TmpData^, RowSize);
  4590. inc(SourceData, RowSize);
  4591. end;
  4592. end;
  4593. result := true;
  4594. end;
  4595. end;
  4596. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4597. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4598. var
  4599. pSource, pData, pTempData: PByte;
  4600. Row, RowSize, TempWidth, TempHeight: Integer;
  4601. IntFormat: TglBitmapFormat;
  4602. fd: TFormatDescriptor;
  4603. Mask: TglBitmapMask;
  4604. function GetRowPointer(Row: Integer): pByte;
  4605. begin
  4606. result := aSurface^.pixels;
  4607. Inc(result, Row * RowSize);
  4608. end;
  4609. begin
  4610. result := false;
  4611. if (Assigned(aSurface)) then begin
  4612. with aSurface^.format^ do begin
  4613. Mask.r := RMask;
  4614. Mask.g := GMask;
  4615. Mask.b := BMask;
  4616. Mask.a := AMask;
  4617. IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
  4618. if (IntFormat = tfEmpty) then
  4619. raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
  4620. end;
  4621. fd := TFormatDescriptor.Get(IntFormat);
  4622. TempWidth := aSurface^.w;
  4623. TempHeight := aSurface^.h;
  4624. RowSize := fd.GetSize(TempWidth, 1);
  4625. GetMem(pData, TempHeight * RowSize);
  4626. try
  4627. pTempData := pData;
  4628. for Row := 0 to TempHeight -1 do begin
  4629. pSource := GetRowPointer(Row);
  4630. if (Assigned(pSource)) then begin
  4631. Move(pSource^, pTempData^, RowSize);
  4632. Inc(pTempData, RowSize);
  4633. end;
  4634. end;
  4635. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4636. result := true;
  4637. except
  4638. if Assigned(pData) then
  4639. FreeMem(pData);
  4640. raise;
  4641. end;
  4642. end;
  4643. end;
  4644. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4645. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4646. var
  4647. Row, Col, AlphaInterleave: Integer;
  4648. pSource, pDest: PByte;
  4649. function GetRowPointer(Row: Integer): pByte;
  4650. begin
  4651. result := aSurface.pixels;
  4652. Inc(result, Row * Width);
  4653. end;
  4654. begin
  4655. result := false;
  4656. if Assigned(Data) then begin
  4657. if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
  4658. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4659. AlphaInterleave := 0;
  4660. case Format of
  4661. tfLuminance8Alpha8ub2:
  4662. AlphaInterleave := 1;
  4663. tfBGRA8ub4, tfRGBA8ub4:
  4664. AlphaInterleave := 3;
  4665. end;
  4666. pSource := Data;
  4667. for Row := 0 to Height -1 do begin
  4668. pDest := GetRowPointer(Row);
  4669. if Assigned(pDest) then begin
  4670. for Col := 0 to Width -1 do begin
  4671. Inc(pSource, AlphaInterleave);
  4672. pDest^ := pSource^;
  4673. Inc(pDest);
  4674. Inc(pSource);
  4675. end;
  4676. end;
  4677. end;
  4678. result := true;
  4679. end;
  4680. end;
  4681. end;
  4682. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4683. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4684. var
  4685. bmp: TglBitmap2D;
  4686. begin
  4687. bmp := TglBitmap2D.Create;
  4688. try
  4689. bmp.AssignFromSurface(aSurface);
  4690. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4691. finally
  4692. bmp.Free;
  4693. end;
  4694. end;
  4695. {$ENDIF}
  4696. {$IFDEF GLB_DELPHI}
  4697. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4698. function CreateGrayPalette: HPALETTE;
  4699. var
  4700. Idx: Integer;
  4701. Pal: PLogPalette;
  4702. begin
  4703. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4704. Pal.palVersion := $300;
  4705. Pal.palNumEntries := 256;
  4706. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4707. Pal.palPalEntry[Idx].peRed := Idx;
  4708. Pal.palPalEntry[Idx].peGreen := Idx;
  4709. Pal.palPalEntry[Idx].peBlue := Idx;
  4710. Pal.palPalEntry[Idx].peFlags := 0;
  4711. end;
  4712. Result := CreatePalette(Pal^);
  4713. FreeMem(Pal);
  4714. end;
  4715. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4716. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4717. var
  4718. Row: Integer;
  4719. pSource, pData: PByte;
  4720. begin
  4721. result := false;
  4722. if Assigned(Data) then begin
  4723. if Assigned(aBitmap) then begin
  4724. aBitmap.Width := Width;
  4725. aBitmap.Height := Height;
  4726. case Format of
  4727. tfAlpha8ub1, tfLuminance8ub1: begin
  4728. aBitmap.PixelFormat := pf8bit;
  4729. aBitmap.Palette := CreateGrayPalette;
  4730. end;
  4731. tfRGB5A1us1:
  4732. aBitmap.PixelFormat := pf15bit;
  4733. tfR5G6B5us1:
  4734. aBitmap.PixelFormat := pf16bit;
  4735. tfRGB8ub3, tfBGR8ub3:
  4736. aBitmap.PixelFormat := pf24bit;
  4737. tfRGBA8ub4, tfBGRA8ub4:
  4738. aBitmap.PixelFormat := pf32bit;
  4739. else
  4740. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4741. end;
  4742. pSource := Data;
  4743. for Row := 0 to FileHeight -1 do begin
  4744. pData := aBitmap.Scanline[Row];
  4745. Move(pSource^, pData^, fRowSize);
  4746. Inc(pSource, fRowSize);
  4747. if (Format in [tfRGB8ub3, tfRGBA8ub4]) then // swap RGB(A) to BGR(A)
  4748. SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
  4749. end;
  4750. result := true;
  4751. end;
  4752. end;
  4753. end;
  4754. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4755. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4756. var
  4757. pSource, pData, pTempData: PByte;
  4758. Row, RowSize, TempWidth, TempHeight: Integer;
  4759. IntFormat: TglBitmapFormat;
  4760. begin
  4761. result := false;
  4762. if (Assigned(aBitmap)) then begin
  4763. case aBitmap.PixelFormat of
  4764. pf8bit:
  4765. IntFormat := tfLuminance8ub1;
  4766. pf15bit:
  4767. IntFormat := tfRGB5A1us1;
  4768. pf16bit:
  4769. IntFormat := tfR5G6B5us1;
  4770. pf24bit:
  4771. IntFormat := tfBGR8ub3;
  4772. pf32bit:
  4773. IntFormat := tfBGRA8ub4;
  4774. else
  4775. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4776. end;
  4777. TempWidth := aBitmap.Width;
  4778. TempHeight := aBitmap.Height;
  4779. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4780. GetMem(pData, TempHeight * RowSize);
  4781. try
  4782. pTempData := pData;
  4783. for Row := 0 to TempHeight -1 do begin
  4784. pSource := aBitmap.Scanline[Row];
  4785. if (Assigned(pSource)) then begin
  4786. Move(pSource^, pTempData^, RowSize);
  4787. Inc(pTempData, RowSize);
  4788. end;
  4789. end;
  4790. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4791. result := true;
  4792. except
  4793. if Assigned(pData) then
  4794. FreeMem(pData);
  4795. raise;
  4796. end;
  4797. end;
  4798. end;
  4799. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4800. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4801. var
  4802. Row, Col, AlphaInterleave: Integer;
  4803. pSource, pDest: PByte;
  4804. begin
  4805. result := false;
  4806. if Assigned(Data) then begin
  4807. if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
  4808. if Assigned(aBitmap) then begin
  4809. aBitmap.PixelFormat := pf8bit;
  4810. aBitmap.Palette := CreateGrayPalette;
  4811. aBitmap.Width := Width;
  4812. aBitmap.Height := Height;
  4813. case Format of
  4814. tfLuminance8Alpha8ub2:
  4815. AlphaInterleave := 1;
  4816. tfRGBA8ub4, tfBGRA8ub4:
  4817. AlphaInterleave := 3;
  4818. else
  4819. AlphaInterleave := 0;
  4820. end;
  4821. // Copy Data
  4822. pSource := Data;
  4823. for Row := 0 to Height -1 do begin
  4824. pDest := aBitmap.Scanline[Row];
  4825. if Assigned(pDest) then begin
  4826. for Col := 0 to Width -1 do begin
  4827. Inc(pSource, AlphaInterleave);
  4828. pDest^ := pSource^;
  4829. Inc(pDest);
  4830. Inc(pSource);
  4831. end;
  4832. end;
  4833. end;
  4834. result := true;
  4835. end;
  4836. end;
  4837. end;
  4838. end;
  4839. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4840. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4841. var
  4842. tex: TglBitmap2D;
  4843. begin
  4844. tex := TglBitmap2D.Create;
  4845. try
  4846. tex.AssignFromBitmap(ABitmap);
  4847. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4848. finally
  4849. tex.Free;
  4850. end;
  4851. end;
  4852. {$ENDIF}
  4853. {$IFDEF GLB_LAZARUS}
  4854. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4855. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4856. var
  4857. rid: TRawImageDescription;
  4858. FormatDesc: TFormatDescriptor;
  4859. begin
  4860. if not Assigned(Data) then
  4861. raise EglBitmap.Create('no pixel data assigned. load data before save');
  4862. result := false;
  4863. if not Assigned(aImage) or (Format = tfEmpty) then
  4864. exit;
  4865. FormatDesc := TFormatDescriptor.Get(Format);
  4866. if FormatDesc.IsCompressed then
  4867. exit;
  4868. FillChar(rid{%H-}, SizeOf(rid), 0);
  4869. if FormatDesc.IsGrayscale then
  4870. rid.Format := ricfGray
  4871. else
  4872. rid.Format := ricfRGBA;
  4873. rid.Width := Width;
  4874. rid.Height := Height;
  4875. rid.Depth := FormatDesc.BitsPerPixel;
  4876. rid.BitOrder := riboBitsInOrder;
  4877. rid.ByteOrder := riboLSBFirst;
  4878. rid.LineOrder := riloTopToBottom;
  4879. rid.LineEnd := rileTight;
  4880. rid.BitsPerPixel := FormatDesc.BitsPerPixel;
  4881. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4882. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4883. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4884. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4885. rid.RedShift := FormatDesc.Shift.r;
  4886. rid.GreenShift := FormatDesc.Shift.g;
  4887. rid.BlueShift := FormatDesc.Shift.b;
  4888. rid.AlphaShift := FormatDesc.Shift.a;
  4889. rid.MaskBitsPerPixel := 0;
  4890. rid.PaletteColorCount := 0;
  4891. aImage.DataDescription := rid;
  4892. aImage.CreateData;
  4893. if not Assigned(aImage.PixelData) then
  4894. raise EglBitmap.Create('error while creating LazIntfImage');
  4895. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4896. result := true;
  4897. end;
  4898. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4899. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4900. var
  4901. f: TglBitmapFormat;
  4902. FormatDesc: TFormatDescriptor;
  4903. ImageData: PByte;
  4904. ImageSize: Integer;
  4905. CanCopy: Boolean;
  4906. Mask: TglBitmapRec4ul;
  4907. procedure CopyConvert;
  4908. var
  4909. bfFormat: TbmpBitfieldFormat;
  4910. pSourceLine, pDestLine: PByte;
  4911. pSourceMD, pDestMD: Pointer;
  4912. Shift, Prec: TglBitmapRec4ub;
  4913. x, y: Integer;
  4914. pixel: TglBitmapPixelData;
  4915. begin
  4916. bfFormat := TbmpBitfieldFormat.Create;
  4917. with aImage.DataDescription do begin
  4918. Prec.r := RedPrec;
  4919. Prec.g := GreenPrec;
  4920. Prec.b := BluePrec;
  4921. Prec.a := AlphaPrec;
  4922. Shift.r := RedShift;
  4923. Shift.g := GreenShift;
  4924. Shift.b := BlueShift;
  4925. Shift.a := AlphaShift;
  4926. bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
  4927. end;
  4928. pSourceMD := bfFormat.CreateMappingData;
  4929. pDestMD := FormatDesc.CreateMappingData;
  4930. try
  4931. for y := 0 to aImage.Height-1 do begin
  4932. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  4933. pDestLine := ImageData + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
  4934. for x := 0 to aImage.Width-1 do begin
  4935. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  4936. FormatDesc.Map(pixel, pDestLine, pDestMD);
  4937. end;
  4938. end;
  4939. finally
  4940. FormatDesc.FreeMappingData(pDestMD);
  4941. bfFormat.FreeMappingData(pSourceMD);
  4942. bfFormat.Free;
  4943. end;
  4944. end;
  4945. begin
  4946. result := false;
  4947. if not Assigned(aImage) then
  4948. exit;
  4949. with aImage.DataDescription do begin
  4950. Mask.r := (QWord(1 shl RedPrec )-1) shl RedShift;
  4951. Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
  4952. Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
  4953. Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
  4954. end;
  4955. FormatDesc := TFormatDescriptor.GetFromMask(Mask);
  4956. f := FormatDesc.Format;
  4957. if (f = tfEmpty) then
  4958. exit;
  4959. CanCopy :=
  4960. (FormatDesc.BitsPerPixel = aImage.DataDescription.Depth) and
  4961. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  4962. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4963. ImageData := GetMem(ImageSize);
  4964. try
  4965. if CanCopy then
  4966. Move(aImage.PixelData^, ImageData^, ImageSize)
  4967. else
  4968. CopyConvert;
  4969. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4970. except
  4971. if Assigned(ImageData) then
  4972. FreeMem(ImageData);
  4973. raise;
  4974. end;
  4975. result := true;
  4976. end;
  4977. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4978. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4979. var
  4980. rid: TRawImageDescription;
  4981. FormatDesc: TFormatDescriptor;
  4982. Pixel: TglBitmapPixelData;
  4983. x, y: Integer;
  4984. srcMD: Pointer;
  4985. src, dst: PByte;
  4986. begin
  4987. result := false;
  4988. if not Assigned(aImage) or (Format = tfEmpty) then
  4989. exit;
  4990. FormatDesc := TFormatDescriptor.Get(Format);
  4991. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4992. exit;
  4993. FillChar(rid{%H-}, SizeOf(rid), 0);
  4994. rid.Format := ricfGray;
  4995. rid.Width := Width;
  4996. rid.Height := Height;
  4997. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4998. rid.BitOrder := riboBitsInOrder;
  4999. rid.ByteOrder := riboLSBFirst;
  5000. rid.LineOrder := riloTopToBottom;
  5001. rid.LineEnd := rileTight;
  5002. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  5003. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  5004. rid.GreenPrec := 0;
  5005. rid.BluePrec := 0;
  5006. rid.AlphaPrec := 0;
  5007. rid.RedShift := 0;
  5008. rid.GreenShift := 0;
  5009. rid.BlueShift := 0;
  5010. rid.AlphaShift := 0;
  5011. rid.MaskBitsPerPixel := 0;
  5012. rid.PaletteColorCount := 0;
  5013. aImage.DataDescription := rid;
  5014. aImage.CreateData;
  5015. srcMD := FormatDesc.CreateMappingData;
  5016. try
  5017. FormatDesc.PreparePixel(Pixel);
  5018. src := Data;
  5019. dst := aImage.PixelData;
  5020. for y := 0 to Height-1 do
  5021. for x := 0 to Width-1 do begin
  5022. FormatDesc.Unmap(src, Pixel, srcMD);
  5023. case rid.BitsPerPixel of
  5024. 8: begin
  5025. dst^ := Pixel.Data.a;
  5026. inc(dst);
  5027. end;
  5028. 16: begin
  5029. PWord(dst)^ := Pixel.Data.a;
  5030. inc(dst, 2);
  5031. end;
  5032. 24: begin
  5033. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  5034. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  5035. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  5036. inc(dst, 3);
  5037. end;
  5038. 32: begin
  5039. PCardinal(dst)^ := Pixel.Data.a;
  5040. inc(dst, 4);
  5041. end;
  5042. else
  5043. raise EglBitmapUnsupportedFormat.Create(Format);
  5044. end;
  5045. end;
  5046. finally
  5047. FormatDesc.FreeMappingData(srcMD);
  5048. end;
  5049. result := true;
  5050. end;
  5051. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5052. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5053. var
  5054. tex: TglBitmap2D;
  5055. begin
  5056. tex := TglBitmap2D.Create;
  5057. try
  5058. tex.AssignFromLazIntfImage(aImage);
  5059. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  5060. finally
  5061. tex.Free;
  5062. end;
  5063. end;
  5064. {$ENDIF}
  5065. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5066. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  5067. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5068. var
  5069. rs: TResourceStream;
  5070. begin
  5071. PrepareResType(aResource, aResType);
  5072. rs := TResourceStream.Create(aInstance, aResource, aResType);
  5073. try
  5074. result := AddAlphaFromStream(rs, aFunc, aArgs);
  5075. finally
  5076. rs.Free;
  5077. end;
  5078. end;
  5079. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5080. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  5081. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5082. var
  5083. rs: TResourceStream;
  5084. begin
  5085. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  5086. try
  5087. result := AddAlphaFromStream(rs, aFunc, aArgs);
  5088. finally
  5089. rs.Free;
  5090. end;
  5091. end;
  5092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5093. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5094. begin
  5095. if TFormatDescriptor.Get(Format).IsCompressed then
  5096. raise EglBitmapUnsupportedFormat.Create(Format);
  5097. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  5098. end;
  5099. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5100. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5101. var
  5102. FS: TFileStream;
  5103. begin
  5104. FS := TFileStream.Create(aFileName, fmOpenRead);
  5105. try
  5106. result := AddAlphaFromStream(FS, aFunc, aArgs);
  5107. finally
  5108. FS.Free;
  5109. end;
  5110. end;
  5111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5112. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5113. var
  5114. tex: TglBitmap2D;
  5115. begin
  5116. tex := TglBitmap2D.Create(aStream);
  5117. try
  5118. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  5119. finally
  5120. tex.Free;
  5121. end;
  5122. end;
  5123. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5124. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5125. var
  5126. DestData, DestData2, SourceData: pByte;
  5127. TempHeight, TempWidth: Integer;
  5128. SourceFD, DestFD: TFormatDescriptor;
  5129. SourceMD, DestMD, DestMD2: Pointer;
  5130. FuncRec: TglBitmapFunctionRec;
  5131. begin
  5132. result := false;
  5133. Assert(Assigned(Data));
  5134. Assert(Assigned(aBitmap));
  5135. Assert(Assigned(aBitmap.Data));
  5136. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  5137. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  5138. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  5139. DestFD := TFormatDescriptor.Get(Format);
  5140. if not Assigned(aFunc) then begin
  5141. aFunc := glBitmapAlphaFunc;
  5142. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  5143. end else
  5144. FuncRec.Args := aArgs;
  5145. // Values
  5146. TempHeight := aBitmap.FileHeight;
  5147. TempWidth := aBitmap.FileWidth;
  5148. FuncRec.Sender := Self;
  5149. FuncRec.Size := Dimension;
  5150. FuncRec.Position.Fields := FuncRec.Size.Fields;
  5151. DestData := Data;
  5152. DestData2 := Data;
  5153. SourceData := aBitmap.Data;
  5154. // Mapping
  5155. SourceFD.PreparePixel(FuncRec.Source);
  5156. DestFD.PreparePixel (FuncRec.Dest);
  5157. SourceMD := SourceFD.CreateMappingData;
  5158. DestMD := DestFD.CreateMappingData;
  5159. DestMD2 := DestFD.CreateMappingData;
  5160. try
  5161. FuncRec.Position.Y := 0;
  5162. while FuncRec.Position.Y < TempHeight do begin
  5163. FuncRec.Position.X := 0;
  5164. while FuncRec.Position.X < TempWidth do begin
  5165. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  5166. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  5167. aFunc(FuncRec);
  5168. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  5169. inc(FuncRec.Position.X);
  5170. end;
  5171. inc(FuncRec.Position.Y);
  5172. end;
  5173. finally
  5174. SourceFD.FreeMappingData(SourceMD);
  5175. DestFD.FreeMappingData(DestMD);
  5176. DestFD.FreeMappingData(DestMD2);
  5177. end;
  5178. end;
  5179. end;
  5180. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5181. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  5182. begin
  5183. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  5184. end;
  5185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5186. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  5187. var
  5188. PixelData: TglBitmapPixelData;
  5189. begin
  5190. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5191. result := AddAlphaFromColorKeyFloat(
  5192. aRed / PixelData.Range.r,
  5193. aGreen / PixelData.Range.g,
  5194. aBlue / PixelData.Range.b,
  5195. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  5196. end;
  5197. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5198. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  5199. var
  5200. values: array[0..2] of Single;
  5201. tmp: Cardinal;
  5202. i: Integer;
  5203. PixelData: TglBitmapPixelData;
  5204. begin
  5205. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5206. with PixelData do begin
  5207. values[0] := aRed;
  5208. values[1] := aGreen;
  5209. values[2] := aBlue;
  5210. for i := 0 to 2 do begin
  5211. tmp := Trunc(Range.arr[i] * aDeviation);
  5212. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  5213. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  5214. end;
  5215. Data.a := 0;
  5216. Range.a := 0;
  5217. end;
  5218. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  5219. end;
  5220. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5221. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  5222. begin
  5223. result := AddAlphaFromValueFloat(aAlpha / $FF);
  5224. end;
  5225. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5226. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  5227. var
  5228. PixelData: TglBitmapPixelData;
  5229. begin
  5230. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5231. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  5232. end;
  5233. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5234. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  5235. var
  5236. PixelData: TglBitmapPixelData;
  5237. begin
  5238. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5239. with PixelData do
  5240. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  5241. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  5242. end;
  5243. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5244. function TglBitmap.RemoveAlpha: Boolean;
  5245. var
  5246. FormatDesc: TFormatDescriptor;
  5247. begin
  5248. result := false;
  5249. FormatDesc := TFormatDescriptor.Get(Format);
  5250. if Assigned(Data) then begin
  5251. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  5252. raise EglBitmapUnsupportedFormat.Create(Format);
  5253. result := ConvertTo(FormatDesc.WithoutAlpha);
  5254. end;
  5255. end;
  5256. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5257. function TglBitmap.Clone: TglBitmap;
  5258. var
  5259. Temp: TglBitmap;
  5260. TempPtr: PByte;
  5261. Size: Integer;
  5262. begin
  5263. result := nil;
  5264. Temp := (ClassType.Create as TglBitmap);
  5265. try
  5266. // copy texture data if assigned
  5267. if Assigned(Data) then begin
  5268. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  5269. GetMem(TempPtr, Size);
  5270. try
  5271. Move(Data^, TempPtr^, Size);
  5272. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  5273. except
  5274. if Assigned(TempPtr) then
  5275. FreeMem(TempPtr);
  5276. raise;
  5277. end;
  5278. end else begin
  5279. TempPtr := nil;
  5280. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  5281. end;
  5282. // copy properties
  5283. Temp.fID := ID;
  5284. Temp.fTarget := Target;
  5285. Temp.fFormat := Format;
  5286. Temp.fMipMap := MipMap;
  5287. Temp.fAnisotropic := Anisotropic;
  5288. Temp.fBorderColor := fBorderColor;
  5289. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  5290. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  5291. Temp.fFilterMin := fFilterMin;
  5292. Temp.fFilterMag := fFilterMag;
  5293. Temp.fWrapS := fWrapS;
  5294. Temp.fWrapT := fWrapT;
  5295. Temp.fWrapR := fWrapR;
  5296. Temp.fFilename := fFilename;
  5297. Temp.fCustomName := fCustomName;
  5298. Temp.fCustomNameW := fCustomNameW;
  5299. Temp.fCustomData := fCustomData;
  5300. result := Temp;
  5301. except
  5302. FreeAndNil(Temp);
  5303. raise;
  5304. end;
  5305. end;
  5306. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5307. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  5308. var
  5309. SourceFD, DestFD: TFormatDescriptor;
  5310. SourcePD, DestPD: TglBitmapPixelData;
  5311. ShiftData: TShiftData;
  5312. function DataIsIdentical: Boolean;
  5313. begin
  5314. result := SourceFD.MaskMatch(DestFD.Mask);
  5315. end;
  5316. function CanCopyDirect: Boolean;
  5317. begin
  5318. result :=
  5319. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5320. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5321. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5322. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5323. end;
  5324. function CanShift: Boolean;
  5325. begin
  5326. result :=
  5327. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5328. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5329. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5330. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5331. end;
  5332. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  5333. begin
  5334. result := 0;
  5335. while (aSource > aDest) and (aSource > 0) do begin
  5336. inc(result);
  5337. aSource := aSource shr 1;
  5338. end;
  5339. end;
  5340. begin
  5341. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  5342. SourceFD := TFormatDescriptor.Get(Format);
  5343. DestFD := TFormatDescriptor.Get(aFormat);
  5344. if DataIsIdentical then begin
  5345. result := true;
  5346. Format := aFormat;
  5347. exit;
  5348. end;
  5349. SourceFD.PreparePixel(SourcePD);
  5350. DestFD.PreparePixel (DestPD);
  5351. if CanCopyDirect then
  5352. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  5353. else if CanShift then begin
  5354. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  5355. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  5356. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  5357. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  5358. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  5359. end else
  5360. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  5361. end else
  5362. result := true;
  5363. end;
  5364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5365. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  5366. begin
  5367. if aUseRGB or aUseAlpha then
  5368. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  5369. ((Byte(aUseAlpha) and 1) shl 1) or
  5370. (Byte(aUseRGB) and 1) ));
  5371. end;
  5372. {$IFNDEF OPENGL_ES}
  5373. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5374. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  5375. begin
  5376. fBorderColor[0] := aRed;
  5377. fBorderColor[1] := aGreen;
  5378. fBorderColor[2] := aBlue;
  5379. fBorderColor[3] := aAlpha;
  5380. if (ID > 0) then begin
  5381. Bind(false);
  5382. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  5383. end;
  5384. end;
  5385. {$ENDIF}
  5386. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5387. procedure TglBitmap.FreeData;
  5388. var
  5389. TempPtr: PByte;
  5390. begin
  5391. TempPtr := nil;
  5392. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  5393. end;
  5394. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5395. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  5396. const aAlpha: Byte);
  5397. begin
  5398. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  5399. end;
  5400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5401. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  5402. var
  5403. PixelData: TglBitmapPixelData;
  5404. begin
  5405. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5406. FillWithColorFloat(
  5407. aRed / PixelData.Range.r,
  5408. aGreen / PixelData.Range.g,
  5409. aBlue / PixelData.Range.b,
  5410. aAlpha / PixelData.Range.a);
  5411. end;
  5412. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5413. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  5414. var
  5415. PixelData: TglBitmapPixelData;
  5416. begin
  5417. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  5418. with PixelData do begin
  5419. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  5420. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  5421. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  5422. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  5423. end;
  5424. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  5425. end;
  5426. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5427. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  5428. begin
  5429. //check MIN filter
  5430. case aMin of
  5431. GL_NEAREST:
  5432. fFilterMin := GL_NEAREST;
  5433. GL_LINEAR:
  5434. fFilterMin := GL_LINEAR;
  5435. GL_NEAREST_MIPMAP_NEAREST:
  5436. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  5437. GL_LINEAR_MIPMAP_NEAREST:
  5438. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  5439. GL_NEAREST_MIPMAP_LINEAR:
  5440. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  5441. GL_LINEAR_MIPMAP_LINEAR:
  5442. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  5443. else
  5444. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  5445. end;
  5446. //check MAG filter
  5447. case aMag of
  5448. GL_NEAREST:
  5449. fFilterMag := GL_NEAREST;
  5450. GL_LINEAR:
  5451. fFilterMag := GL_LINEAR;
  5452. else
  5453. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  5454. end;
  5455. //apply filter
  5456. if (ID > 0) then begin
  5457. Bind(false);
  5458. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  5459. if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
  5460. case fFilterMin of
  5461. GL_NEAREST, GL_LINEAR:
  5462. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5463. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  5464. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  5465. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  5466. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  5467. end;
  5468. end else
  5469. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5470. end;
  5471. end;
  5472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5473. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  5474. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  5475. begin
  5476. case aValue of
  5477. {$IFNDEF OPENGL_ES}
  5478. GL_CLAMP:
  5479. aTarget := GL_CLAMP;
  5480. {$ENDIF}
  5481. GL_REPEAT:
  5482. aTarget := GL_REPEAT;
  5483. GL_CLAMP_TO_EDGE: begin
  5484. {$IFNDEF OPENGL_ES}
  5485. if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
  5486. aTarget := GL_CLAMP
  5487. else
  5488. {$ENDIF}
  5489. aTarget := GL_CLAMP_TO_EDGE;
  5490. end;
  5491. {$IFNDEF OPENGL_ES}
  5492. GL_CLAMP_TO_BORDER: begin
  5493. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  5494. aTarget := GL_CLAMP_TO_BORDER
  5495. else
  5496. aTarget := GL_CLAMP;
  5497. end;
  5498. {$ENDIF}
  5499. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  5500. GL_MIRRORED_REPEAT: begin
  5501. {$IFNDEF OPENGL_ES}
  5502. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  5503. {$ELSE}
  5504. if GL_VERSION_2_0 then
  5505. {$ENDIF}
  5506. aTarget := GL_MIRRORED_REPEAT
  5507. else
  5508. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  5509. end;
  5510. {$IFEND}
  5511. else
  5512. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  5513. end;
  5514. end;
  5515. begin
  5516. CheckAndSetWrap(S, fWrapS);
  5517. CheckAndSetWrap(T, fWrapT);
  5518. CheckAndSetWrap(R, fWrapR);
  5519. if (ID > 0) then begin
  5520. Bind(false);
  5521. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  5522. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  5523. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  5524. {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
  5525. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  5526. {$IFEND}
  5527. end;
  5528. end;
  5529. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  5530. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5531. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  5532. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  5533. begin
  5534. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  5535. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  5536. fSwizzle[aIndex] := aValue
  5537. else
  5538. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  5539. end;
  5540. begin
  5541. {$IFNDEF OPENGL_ES}
  5542. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  5543. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  5544. {$ELSE}
  5545. if not GL_VERSION_3_0 then
  5546. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  5547. {$ENDIF}
  5548. CheckAndSetValue(r, 0);
  5549. CheckAndSetValue(g, 1);
  5550. CheckAndSetValue(b, 2);
  5551. CheckAndSetValue(a, 3);
  5552. if (ID > 0) then begin
  5553. Bind(false);
  5554. {$IFNDEF OPENGL_ES}
  5555. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  5556. {$ELSE}
  5557. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
  5558. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
  5559. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
  5560. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
  5561. {$ENDIF}
  5562. end;
  5563. end;
  5564. {$IFEND}
  5565. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5566. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  5567. begin
  5568. if aEnableTextureUnit then
  5569. glEnable(Target);
  5570. if (ID > 0) then
  5571. glBindTexture(Target, ID);
  5572. end;
  5573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5574. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  5575. begin
  5576. if aDisableTextureUnit then
  5577. glDisable(Target);
  5578. glBindTexture(Target, 0);
  5579. end;
  5580. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5581. constructor TglBitmap.Create;
  5582. begin
  5583. if (ClassType = TglBitmap) then
  5584. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  5585. {$IFDEF GLB_NATIVE_OGL}
  5586. glbReadOpenGLExtensions;
  5587. {$ENDIF}
  5588. inherited Create;
  5589. fFormat := glBitmapGetDefaultFormat;
  5590. fFreeDataOnDestroy := true;
  5591. end;
  5592. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5593. constructor TglBitmap.Create(const aFileName: String);
  5594. begin
  5595. Create;
  5596. LoadFromFile(aFileName);
  5597. end;
  5598. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5599. constructor TglBitmap.Create(const aStream: TStream);
  5600. begin
  5601. Create;
  5602. LoadFromStream(aStream);
  5603. end;
  5604. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5605. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
  5606. var
  5607. ImageSize: Integer;
  5608. begin
  5609. Create;
  5610. if not Assigned(aData) then begin
  5611. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5612. GetMem(aData, ImageSize);
  5613. try
  5614. FillChar(aData^, ImageSize, #$FF);
  5615. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5616. except
  5617. if Assigned(aData) then
  5618. FreeMem(aData);
  5619. raise;
  5620. end;
  5621. end else begin
  5622. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5623. fFreeDataOnDestroy := false;
  5624. end;
  5625. end;
  5626. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5627. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5628. begin
  5629. Create;
  5630. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  5631. end;
  5632. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5633. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  5634. begin
  5635. Create;
  5636. LoadFromResource(aInstance, aResource, aResType);
  5637. end;
  5638. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5639. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5640. begin
  5641. Create;
  5642. LoadFromResourceID(aInstance, aResourceID, aResType);
  5643. end;
  5644. {$IFDEF GLB_SUPPORT_PNG_READ}
  5645. {$IF DEFINED(GLB_LAZ_PNG)}
  5646. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5647. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5648. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5649. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5650. const
  5651. MAGIC_LEN = 8;
  5652. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  5653. var
  5654. reader: TLazReaderPNG;
  5655. intf: TLazIntfImage;
  5656. StreamPos: Int64;
  5657. magic: String[MAGIC_LEN];
  5658. begin
  5659. result := true;
  5660. StreamPos := aStream.Position;
  5661. SetLength(magic, MAGIC_LEN);
  5662. aStream.Read(magic[1], MAGIC_LEN);
  5663. aStream.Position := StreamPos;
  5664. if (magic <> PNG_MAGIC) then begin
  5665. result := false;
  5666. exit;
  5667. end;
  5668. intf := TLazIntfImage.Create(0, 0);
  5669. reader := TLazReaderPNG.Create;
  5670. try try
  5671. reader.UpdateDescription := true;
  5672. reader.ImageRead(aStream, intf);
  5673. AssignFromLazIntfImage(intf);
  5674. except
  5675. result := false;
  5676. aStream.Position := StreamPos;
  5677. exit;
  5678. end;
  5679. finally
  5680. reader.Free;
  5681. intf.Free;
  5682. end;
  5683. end;
  5684. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5685. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5686. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5687. var
  5688. Surface: PSDL_Surface;
  5689. RWops: PSDL_RWops;
  5690. begin
  5691. result := false;
  5692. RWops := glBitmapCreateRWops(aStream);
  5693. try
  5694. if IMG_isPNG(RWops) > 0 then begin
  5695. Surface := IMG_LoadPNG_RW(RWops);
  5696. try
  5697. AssignFromSurface(Surface);
  5698. result := true;
  5699. finally
  5700. SDL_FreeSurface(Surface);
  5701. end;
  5702. end;
  5703. finally
  5704. SDL_FreeRW(RWops);
  5705. end;
  5706. end;
  5707. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5708. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5709. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5710. begin
  5711. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5712. end;
  5713. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5714. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5715. var
  5716. StreamPos: Int64;
  5717. signature: array [0..7] of byte;
  5718. png: png_structp;
  5719. png_info: png_infop;
  5720. TempHeight, TempWidth: Integer;
  5721. Format: TglBitmapFormat;
  5722. png_data: pByte;
  5723. png_rows: array of pByte;
  5724. Row, LineSize: Integer;
  5725. begin
  5726. result := false;
  5727. if not init_libPNG then
  5728. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5729. try
  5730. // signature
  5731. StreamPos := aStream.Position;
  5732. aStream.Read(signature{%H-}, 8);
  5733. aStream.Position := StreamPos;
  5734. if png_check_sig(@signature, 8) <> 0 then begin
  5735. // png read struct
  5736. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5737. if png = nil then
  5738. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5739. // png info
  5740. png_info := png_create_info_struct(png);
  5741. if png_info = nil then begin
  5742. png_destroy_read_struct(@png, nil, nil);
  5743. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5744. end;
  5745. // set read callback
  5746. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5747. // read informations
  5748. png_read_info(png, png_info);
  5749. // size
  5750. TempHeight := png_get_image_height(png, png_info);
  5751. TempWidth := png_get_image_width(png, png_info);
  5752. // format
  5753. case png_get_color_type(png, png_info) of
  5754. PNG_COLOR_TYPE_GRAY:
  5755. Format := tfLuminance8ub1;
  5756. PNG_COLOR_TYPE_GRAY_ALPHA:
  5757. Format := tfLuminance8Alpha8us1;
  5758. PNG_COLOR_TYPE_RGB:
  5759. Format := tfRGB8ub3;
  5760. PNG_COLOR_TYPE_RGB_ALPHA:
  5761. Format := tfRGBA8ub4;
  5762. else
  5763. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5764. end;
  5765. // cut upper 8 bit from 16 bit formats
  5766. if png_get_bit_depth(png, png_info) > 8 then
  5767. png_set_strip_16(png);
  5768. // expand bitdepth smaller than 8
  5769. if png_get_bit_depth(png, png_info) < 8 then
  5770. png_set_expand(png);
  5771. // allocating mem for scanlines
  5772. LineSize := png_get_rowbytes(png, png_info);
  5773. GetMem(png_data, TempHeight * LineSize);
  5774. try
  5775. SetLength(png_rows, TempHeight);
  5776. for Row := Low(png_rows) to High(png_rows) do begin
  5777. png_rows[Row] := png_data;
  5778. Inc(png_rows[Row], Row * LineSize);
  5779. end;
  5780. // read complete image into scanlines
  5781. png_read_image(png, @png_rows[0]);
  5782. // read end
  5783. png_read_end(png, png_info);
  5784. // destroy read struct
  5785. png_destroy_read_struct(@png, @png_info, nil);
  5786. SetLength(png_rows, 0);
  5787. // set new data
  5788. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5789. result := true;
  5790. except
  5791. if Assigned(png_data) then
  5792. FreeMem(png_data);
  5793. raise;
  5794. end;
  5795. end;
  5796. finally
  5797. quit_libPNG;
  5798. end;
  5799. end;
  5800. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5801. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5802. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5803. var
  5804. StreamPos: Int64;
  5805. Png: TPNGObject;
  5806. Header: String[8];
  5807. Row, Col, PixSize, LineSize: Integer;
  5808. NewImage, pSource, pDest, pAlpha: pByte;
  5809. PngFormat: TglBitmapFormat;
  5810. FormatDesc: TFormatDescriptor;
  5811. const
  5812. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5813. begin
  5814. result := false;
  5815. StreamPos := aStream.Position;
  5816. aStream.Read(Header[0], SizeOf(Header));
  5817. aStream.Position := StreamPos;
  5818. {Test if the header matches}
  5819. if Header = PngHeader then begin
  5820. Png := TPNGObject.Create;
  5821. try
  5822. Png.LoadFromStream(aStream);
  5823. case Png.Header.ColorType of
  5824. COLOR_GRAYSCALE:
  5825. PngFormat := tfLuminance8ub1;
  5826. COLOR_GRAYSCALEALPHA:
  5827. PngFormat := tfLuminance8Alpha8us1;
  5828. COLOR_RGB:
  5829. PngFormat := tfBGR8ub3;
  5830. COLOR_RGBALPHA:
  5831. PngFormat := tfBGRA8ub4;
  5832. else
  5833. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5834. end;
  5835. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5836. PixSize := Round(FormatDesc.PixelSize);
  5837. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5838. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5839. try
  5840. pDest := NewImage;
  5841. case Png.Header.ColorType of
  5842. COLOR_RGB, COLOR_GRAYSCALE:
  5843. begin
  5844. for Row := 0 to Png.Height -1 do begin
  5845. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5846. Inc(pDest, LineSize);
  5847. end;
  5848. end;
  5849. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5850. begin
  5851. PixSize := PixSize -1;
  5852. for Row := 0 to Png.Height -1 do begin
  5853. pSource := Png.Scanline[Row];
  5854. pAlpha := pByte(Png.AlphaScanline[Row]);
  5855. for Col := 0 to Png.Width -1 do begin
  5856. Move (pSource^, pDest^, PixSize);
  5857. Inc(pSource, PixSize);
  5858. Inc(pDest, PixSize);
  5859. pDest^ := pAlpha^;
  5860. inc(pAlpha);
  5861. Inc(pDest);
  5862. end;
  5863. end;
  5864. end;
  5865. else
  5866. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5867. end;
  5868. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5869. result := true;
  5870. except
  5871. if Assigned(NewImage) then
  5872. FreeMem(NewImage);
  5873. raise;
  5874. end;
  5875. finally
  5876. Png.Free;
  5877. end;
  5878. end;
  5879. end;
  5880. {$IFEND}
  5881. {$ENDIF}
  5882. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5883. {$IFDEF GLB_LIB_PNG}
  5884. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5885. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5886. begin
  5887. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5888. end;
  5889. {$ENDIF}
  5890. {$IF DEFINED(GLB_LAZ_PNG)}
  5891. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5892. procedure TglBitmap.SavePNG(const aStream: TStream);
  5893. var
  5894. png: TPortableNetworkGraphic;
  5895. intf: TLazIntfImage;
  5896. raw: TRawImage;
  5897. begin
  5898. png := TPortableNetworkGraphic.Create;
  5899. intf := TLazIntfImage.Create(0, 0);
  5900. try
  5901. if not AssignToLazIntfImage(intf) then
  5902. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5903. intf.GetRawImage(raw);
  5904. png.LoadFromRawImage(raw, false);
  5905. png.SaveToStream(aStream);
  5906. finally
  5907. png.Free;
  5908. intf.Free;
  5909. end;
  5910. end;
  5911. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5912. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5913. procedure TglBitmap.SavePNG(const aStream: TStream);
  5914. var
  5915. png: png_structp;
  5916. png_info: png_infop;
  5917. png_rows: array of pByte;
  5918. LineSize: Integer;
  5919. ColorType: Integer;
  5920. Row: Integer;
  5921. FormatDesc: TFormatDescriptor;
  5922. begin
  5923. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5924. raise EglBitmapUnsupportedFormat.Create(Format);
  5925. if not init_libPNG then
  5926. raise Exception.Create('unable to initialize libPNG.');
  5927. try
  5928. case Format of
  5929. tfAlpha8ub1, tfLuminance8ub1:
  5930. ColorType := PNG_COLOR_TYPE_GRAY;
  5931. tfLuminance8Alpha8us1:
  5932. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5933. tfBGR8ub3, tfRGB8ub3:
  5934. ColorType := PNG_COLOR_TYPE_RGB;
  5935. tfBGRA8ub4, tfRGBA8ub4:
  5936. ColorType := PNG_COLOR_TYPE_RGBA;
  5937. else
  5938. raise EglBitmapUnsupportedFormat.Create(Format);
  5939. end;
  5940. FormatDesc := TFormatDescriptor.Get(Format);
  5941. LineSize := FormatDesc.GetSize(Width, 1);
  5942. // creating array for scanline
  5943. SetLength(png_rows, Height);
  5944. try
  5945. for Row := 0 to Height - 1 do begin
  5946. png_rows[Row] := Data;
  5947. Inc(png_rows[Row], Row * LineSize)
  5948. end;
  5949. // write struct
  5950. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5951. if png = nil then
  5952. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5953. // create png info
  5954. png_info := png_create_info_struct(png);
  5955. if png_info = nil then begin
  5956. png_destroy_write_struct(@png, nil);
  5957. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5958. end;
  5959. // set read callback
  5960. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5961. // set compression
  5962. png_set_compression_level(png, 6);
  5963. if Format in [tfBGR8ub3, tfBGRA8ub4] then
  5964. png_set_bgr(png);
  5965. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5966. png_write_info(png, png_info);
  5967. png_write_image(png, @png_rows[0]);
  5968. png_write_end(png, png_info);
  5969. png_destroy_write_struct(@png, @png_info);
  5970. finally
  5971. SetLength(png_rows, 0);
  5972. end;
  5973. finally
  5974. quit_libPNG;
  5975. end;
  5976. end;
  5977. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5978. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5979. procedure TglBitmap.SavePNG(const aStream: TStream);
  5980. var
  5981. Png: TPNGObject;
  5982. pSource, pDest: pByte;
  5983. X, Y, PixSize: Integer;
  5984. ColorType: Cardinal;
  5985. Alpha: Boolean;
  5986. pTemp: pByte;
  5987. Temp: Byte;
  5988. begin
  5989. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5990. raise EglBitmapUnsupportedFormat.Create(Format);
  5991. case Format of
  5992. tfAlpha8ub1, tfLuminance8ub1: begin
  5993. ColorType := COLOR_GRAYSCALE;
  5994. PixSize := 1;
  5995. Alpha := false;
  5996. end;
  5997. tfLuminance8Alpha8us1: begin
  5998. ColorType := COLOR_GRAYSCALEALPHA;
  5999. PixSize := 1;
  6000. Alpha := true;
  6001. end;
  6002. tfBGR8ub3, tfRGB8ub3: begin
  6003. ColorType := COLOR_RGB;
  6004. PixSize := 3;
  6005. Alpha := false;
  6006. end;
  6007. tfBGRA8ub4, tfRGBA8ub4: begin
  6008. ColorType := COLOR_RGBALPHA;
  6009. PixSize := 3;
  6010. Alpha := true
  6011. end;
  6012. else
  6013. raise EglBitmapUnsupportedFormat.Create(Format);
  6014. end;
  6015. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  6016. try
  6017. // Copy ImageData
  6018. pSource := Data;
  6019. for Y := 0 to Height -1 do begin
  6020. pDest := png.ScanLine[Y];
  6021. for X := 0 to Width -1 do begin
  6022. Move(pSource^, pDest^, PixSize);
  6023. Inc(pDest, PixSize);
  6024. Inc(pSource, PixSize);
  6025. if Alpha then begin
  6026. png.AlphaScanline[Y]^[X] := pSource^;
  6027. Inc(pSource);
  6028. end;
  6029. end;
  6030. // convert RGB line to BGR
  6031. if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
  6032. pTemp := png.ScanLine[Y];
  6033. for X := 0 to Width -1 do begin
  6034. Temp := pByteArray(pTemp)^[0];
  6035. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  6036. pByteArray(pTemp)^[2] := Temp;
  6037. Inc(pTemp, 3);
  6038. end;
  6039. end;
  6040. end;
  6041. // Save to Stream
  6042. Png.CompressionLevel := 6;
  6043. Png.SaveToStream(aStream);
  6044. finally
  6045. FreeAndNil(Png);
  6046. end;
  6047. end;
  6048. {$IFEND}
  6049. {$ENDIF}
  6050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6051. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6053. {$IFDEF GLB_LIB_JPEG}
  6054. type
  6055. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  6056. glBitmap_libJPEG_source_mgr = record
  6057. pub: jpeg_source_mgr;
  6058. SrcStream: TStream;
  6059. SrcBuffer: array [1..4096] of byte;
  6060. end;
  6061. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  6062. glBitmap_libJPEG_dest_mgr = record
  6063. pub: jpeg_destination_mgr;
  6064. DestStream: TStream;
  6065. DestBuffer: array [1..4096] of byte;
  6066. end;
  6067. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  6068. begin
  6069. //DUMMY
  6070. end;
  6071. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  6072. begin
  6073. //DUMMY
  6074. end;
  6075. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  6076. begin
  6077. //DUMMY
  6078. end;
  6079. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  6080. begin
  6081. //DUMMY
  6082. end;
  6083. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  6084. begin
  6085. //DUMMY
  6086. end;
  6087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6088. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  6089. var
  6090. src: glBitmap_libJPEG_source_mgr_ptr;
  6091. bytes: integer;
  6092. begin
  6093. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  6094. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  6095. if (bytes <= 0) then begin
  6096. src^.SrcBuffer[1] := $FF;
  6097. src^.SrcBuffer[2] := JPEG_EOI;
  6098. bytes := 2;
  6099. end;
  6100. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  6101. src^.pub.bytes_in_buffer := bytes;
  6102. result := true;
  6103. end;
  6104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6105. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  6106. var
  6107. src: glBitmap_libJPEG_source_mgr_ptr;
  6108. begin
  6109. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  6110. if num_bytes > 0 then begin
  6111. // wanted byte isn't in buffer so set stream position and read buffer
  6112. if num_bytes > src^.pub.bytes_in_buffer then begin
  6113. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  6114. src^.pub.fill_input_buffer(cinfo);
  6115. end else begin
  6116. // wanted byte is in buffer so only skip
  6117. inc(src^.pub.next_input_byte, num_bytes);
  6118. dec(src^.pub.bytes_in_buffer, num_bytes);
  6119. end;
  6120. end;
  6121. end;
  6122. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6123. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  6124. var
  6125. dest: glBitmap_libJPEG_dest_mgr_ptr;
  6126. begin
  6127. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  6128. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  6129. // write complete buffer
  6130. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  6131. // reset buffer
  6132. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  6133. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  6134. end;
  6135. result := true;
  6136. end;
  6137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6138. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  6139. var
  6140. Idx: Integer;
  6141. dest: glBitmap_libJPEG_dest_mgr_ptr;
  6142. begin
  6143. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  6144. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  6145. // check for endblock
  6146. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  6147. // write endblock
  6148. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  6149. // leave
  6150. break;
  6151. end else
  6152. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  6153. end;
  6154. end;
  6155. {$ENDIF}
  6156. {$IFDEF GLB_SUPPORT_JPEG_READ}
  6157. {$IF DEFINED(GLB_LAZ_JPEG)}
  6158. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6159. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6160. const
  6161. MAGIC_LEN = 2;
  6162. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  6163. var
  6164. intf: TLazIntfImage;
  6165. reader: TFPReaderJPEG;
  6166. StreamPos: Int64;
  6167. magic: String[MAGIC_LEN];
  6168. begin
  6169. result := true;
  6170. StreamPos := aStream.Position;
  6171. SetLength(magic, MAGIC_LEN);
  6172. aStream.Read(magic[1], MAGIC_LEN);
  6173. aStream.Position := StreamPos;
  6174. if (magic <> JPEG_MAGIC) then begin
  6175. result := false;
  6176. exit;
  6177. end;
  6178. reader := TFPReaderJPEG.Create;
  6179. intf := TLazIntfImage.Create(0, 0);
  6180. try try
  6181. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  6182. reader.ImageRead(aStream, intf);
  6183. AssignFromLazIntfImage(intf);
  6184. except
  6185. result := false;
  6186. aStream.Position := StreamPos;
  6187. exit;
  6188. end;
  6189. finally
  6190. reader.Free;
  6191. intf.Free;
  6192. end;
  6193. end;
  6194. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  6195. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6196. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6197. var
  6198. Surface: PSDL_Surface;
  6199. RWops: PSDL_RWops;
  6200. begin
  6201. result := false;
  6202. RWops := glBitmapCreateRWops(aStream);
  6203. try
  6204. if IMG_isJPG(RWops) > 0 then begin
  6205. Surface := IMG_LoadJPG_RW(RWops);
  6206. try
  6207. AssignFromSurface(Surface);
  6208. result := true;
  6209. finally
  6210. SDL_FreeSurface(Surface);
  6211. end;
  6212. end;
  6213. finally
  6214. SDL_FreeRW(RWops);
  6215. end;
  6216. end;
  6217. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  6218. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6219. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6220. var
  6221. StreamPos: Int64;
  6222. Temp: array[0..1]of Byte;
  6223. jpeg: jpeg_decompress_struct;
  6224. jpeg_err: jpeg_error_mgr;
  6225. IntFormat: TglBitmapFormat;
  6226. pImage: pByte;
  6227. TempHeight, TempWidth: Integer;
  6228. pTemp: pByte;
  6229. Row: Integer;
  6230. FormatDesc: TFormatDescriptor;
  6231. begin
  6232. result := false;
  6233. if not init_libJPEG then
  6234. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  6235. try
  6236. // reading first two bytes to test file and set cursor back to begin
  6237. StreamPos := aStream.Position;
  6238. aStream.Read({%H-}Temp[0], 2);
  6239. aStream.Position := StreamPos;
  6240. // if Bitmap then read file.
  6241. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  6242. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  6243. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  6244. // error managment
  6245. jpeg.err := jpeg_std_error(@jpeg_err);
  6246. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  6247. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  6248. // decompression struct
  6249. jpeg_create_decompress(@jpeg);
  6250. // allocation space for streaming methods
  6251. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  6252. // seeting up custom functions
  6253. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  6254. pub.init_source := glBitmap_libJPEG_init_source;
  6255. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  6256. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  6257. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  6258. pub.term_source := glBitmap_libJPEG_term_source;
  6259. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  6260. pub.next_input_byte := nil; // until buffer loaded
  6261. SrcStream := aStream;
  6262. end;
  6263. // set global decoding state
  6264. jpeg.global_state := DSTATE_START;
  6265. // read header of jpeg
  6266. jpeg_read_header(@jpeg, false);
  6267. // setting output parameter
  6268. case jpeg.jpeg_color_space of
  6269. JCS_GRAYSCALE:
  6270. begin
  6271. jpeg.out_color_space := JCS_GRAYSCALE;
  6272. IntFormat := tfLuminance8ub1;
  6273. end;
  6274. else
  6275. jpeg.out_color_space := JCS_RGB;
  6276. IntFormat := tfRGB8ub3;
  6277. end;
  6278. // reading image
  6279. jpeg_start_decompress(@jpeg);
  6280. TempHeight := jpeg.output_height;
  6281. TempWidth := jpeg.output_width;
  6282. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6283. // creating new image
  6284. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  6285. try
  6286. pTemp := pImage;
  6287. for Row := 0 to TempHeight -1 do begin
  6288. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  6289. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  6290. end;
  6291. // finish decompression
  6292. jpeg_finish_decompress(@jpeg);
  6293. // destroy decompression
  6294. jpeg_destroy_decompress(@jpeg);
  6295. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  6296. result := true;
  6297. except
  6298. if Assigned(pImage) then
  6299. FreeMem(pImage);
  6300. raise;
  6301. end;
  6302. end;
  6303. finally
  6304. quit_libJPEG;
  6305. end;
  6306. end;
  6307. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  6308. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6309. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6310. var
  6311. bmp: TBitmap;
  6312. jpg: TJPEGImage;
  6313. StreamPos: Int64;
  6314. Temp: array[0..1]of Byte;
  6315. begin
  6316. result := false;
  6317. // reading first two bytes to test file and set cursor back to begin
  6318. StreamPos := aStream.Position;
  6319. aStream.Read(Temp[0], 2);
  6320. aStream.Position := StreamPos;
  6321. // if Bitmap then read file.
  6322. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  6323. bmp := TBitmap.Create;
  6324. try
  6325. jpg := TJPEGImage.Create;
  6326. try
  6327. jpg.LoadFromStream(aStream);
  6328. bmp.Assign(jpg);
  6329. result := AssignFromBitmap(bmp);
  6330. finally
  6331. jpg.Free;
  6332. end;
  6333. finally
  6334. bmp.Free;
  6335. end;
  6336. end;
  6337. end;
  6338. {$IFEND}
  6339. {$ENDIF}
  6340. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  6341. {$IF DEFINED(GLB_LAZ_JPEG)}
  6342. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6343. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6344. var
  6345. jpeg: TJPEGImage;
  6346. intf: TLazIntfImage;
  6347. raw: TRawImage;
  6348. begin
  6349. jpeg := TJPEGImage.Create;
  6350. intf := TLazIntfImage.Create(0, 0);
  6351. try
  6352. if not AssignToLazIntfImage(intf) then
  6353. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  6354. intf.GetRawImage(raw);
  6355. jpeg.LoadFromRawImage(raw, false);
  6356. jpeg.SaveToStream(aStream);
  6357. finally
  6358. intf.Free;
  6359. jpeg.Free;
  6360. end;
  6361. end;
  6362. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  6363. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6364. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6365. var
  6366. jpeg: jpeg_compress_struct;
  6367. jpeg_err: jpeg_error_mgr;
  6368. Row: Integer;
  6369. pTemp, pTemp2: pByte;
  6370. procedure CopyRow(pDest, pSource: pByte);
  6371. var
  6372. X: Integer;
  6373. begin
  6374. for X := 0 to Width - 1 do begin
  6375. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  6376. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  6377. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  6378. Inc(pDest, 3);
  6379. Inc(pSource, 3);
  6380. end;
  6381. end;
  6382. begin
  6383. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6384. raise EglBitmapUnsupportedFormat.Create(Format);
  6385. if not init_libJPEG then
  6386. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  6387. try
  6388. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  6389. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  6390. // error managment
  6391. jpeg.err := jpeg_std_error(@jpeg_err);
  6392. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  6393. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  6394. // compression struct
  6395. jpeg_create_compress(@jpeg);
  6396. // allocation space for streaming methods
  6397. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  6398. // seeting up custom functions
  6399. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  6400. pub.init_destination := glBitmap_libJPEG_init_destination;
  6401. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  6402. pub.term_destination := glBitmap_libJPEG_term_destination;
  6403. pub.next_output_byte := @DestBuffer[1];
  6404. pub.free_in_buffer := Length(DestBuffer);
  6405. DestStream := aStream;
  6406. end;
  6407. // very important state
  6408. jpeg.global_state := CSTATE_START;
  6409. jpeg.image_width := Width;
  6410. jpeg.image_height := Height;
  6411. case Format of
  6412. tfAlpha8ub1, tfLuminance8ub1: begin
  6413. jpeg.input_components := 1;
  6414. jpeg.in_color_space := JCS_GRAYSCALE;
  6415. end;
  6416. tfRGB8ub3, tfBGR8ub3: begin
  6417. jpeg.input_components := 3;
  6418. jpeg.in_color_space := JCS_RGB;
  6419. end;
  6420. end;
  6421. jpeg_set_defaults(@jpeg);
  6422. jpeg_set_quality(@jpeg, 95, true);
  6423. jpeg_start_compress(@jpeg, true);
  6424. pTemp := Data;
  6425. if Format = tfBGR8ub3 then
  6426. GetMem(pTemp2, fRowSize)
  6427. else
  6428. pTemp2 := pTemp;
  6429. try
  6430. for Row := 0 to jpeg.image_height -1 do begin
  6431. // prepare row
  6432. if Format = tfBGR8ub3 then
  6433. CopyRow(pTemp2, pTemp)
  6434. else
  6435. pTemp2 := pTemp;
  6436. // write row
  6437. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  6438. inc(pTemp, fRowSize);
  6439. end;
  6440. finally
  6441. // free memory
  6442. if Format = tfBGR8ub3 then
  6443. FreeMem(pTemp2);
  6444. end;
  6445. jpeg_finish_compress(@jpeg);
  6446. jpeg_destroy_compress(@jpeg);
  6447. finally
  6448. quit_libJPEG;
  6449. end;
  6450. end;
  6451. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  6452. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6453. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6454. var
  6455. Bmp: TBitmap;
  6456. Jpg: TJPEGImage;
  6457. begin
  6458. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6459. raise EglBitmapUnsupportedFormat.Create(Format);
  6460. Bmp := TBitmap.Create;
  6461. try
  6462. Jpg := TJPEGImage.Create;
  6463. try
  6464. AssignToBitmap(Bmp);
  6465. if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
  6466. Jpg.Grayscale := true;
  6467. Jpg.PixelFormat := jf8Bit;
  6468. end;
  6469. Jpg.Assign(Bmp);
  6470. Jpg.SaveToStream(aStream);
  6471. finally
  6472. FreeAndNil(Jpg);
  6473. end;
  6474. finally
  6475. FreeAndNil(Bmp);
  6476. end;
  6477. end;
  6478. {$IFEND}
  6479. {$ENDIF}
  6480. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6481. //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6482. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6483. type
  6484. RawHeader = packed record
  6485. Magic: String[5];
  6486. Version: Byte;
  6487. Width: Integer;
  6488. Height: Integer;
  6489. DataSize: Integer;
  6490. BitsPerPixel: Integer;
  6491. Precision: TglBitmapRec4ub;
  6492. Shift: TglBitmapRec4ub;
  6493. end;
  6494. function TglBitmap.LoadRAW(const aStream: TStream): Boolean;
  6495. var
  6496. header: RawHeader;
  6497. StartPos: Int64;
  6498. fd: TFormatDescriptor;
  6499. buf: PByte;
  6500. begin
  6501. result := false;
  6502. StartPos := aStream.Position;
  6503. aStream.Read(header{%H-}, SizeOf(header));
  6504. if (header.Magic <> 'glBMP') then begin
  6505. aStream.Position := StartPos;
  6506. exit;
  6507. end;
  6508. fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
  6509. if (fd.Format = tfEmpty) then
  6510. raise EglBitmapUnsupportedFormat.Create('no supported format found');
  6511. buf := GetMemory(header.DataSize);
  6512. aStream.Read(buf^, header.DataSize);
  6513. SetDataPointer(buf, fd.Format, header.Width, header.Height);
  6514. result := true;
  6515. end;
  6516. procedure TglBitmap.SaveRAW(const aStream: TStream);
  6517. var
  6518. header: RawHeader;
  6519. fd: TFormatDescriptor;
  6520. begin
  6521. fd := TFormatDescriptor.Get(Format);
  6522. header.Magic := 'glBMP';
  6523. header.Version := 1;
  6524. header.Width := Width;
  6525. header.Height := Height;
  6526. header.DataSize := fd.GetSize(fDimension);
  6527. header.BitsPerPixel := fd.BitsPerPixel;
  6528. header.Precision := fd.Precision;
  6529. header.Shift := fd.Shift;
  6530. aStream.Write(header, SizeOf(header));
  6531. aStream.Write(Data^, header.DataSize);
  6532. end;
  6533. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6534. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6535. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6536. const
  6537. BMP_MAGIC = $4D42;
  6538. BMP_COMP_RGB = 0;
  6539. BMP_COMP_RLE8 = 1;
  6540. BMP_COMP_RLE4 = 2;
  6541. BMP_COMP_BITFIELDS = 3;
  6542. type
  6543. TBMPHeader = packed record
  6544. bfType: Word;
  6545. bfSize: Cardinal;
  6546. bfReserved1: Word;
  6547. bfReserved2: Word;
  6548. bfOffBits: Cardinal;
  6549. end;
  6550. TBMPInfo = packed record
  6551. biSize: Cardinal;
  6552. biWidth: Longint;
  6553. biHeight: Longint;
  6554. biPlanes: Word;
  6555. biBitCount: Word;
  6556. biCompression: Cardinal;
  6557. biSizeImage: Cardinal;
  6558. biXPelsPerMeter: Longint;
  6559. biYPelsPerMeter: Longint;
  6560. biClrUsed: Cardinal;
  6561. biClrImportant: Cardinal;
  6562. end;
  6563. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6564. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  6565. //////////////////////////////////////////////////////////////////////////////////////////////////
  6566. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
  6567. begin
  6568. result := tfEmpty;
  6569. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  6570. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  6571. //Read Compression
  6572. case aInfo.biCompression of
  6573. BMP_COMP_RLE4,
  6574. BMP_COMP_RLE8: begin
  6575. raise EglBitmap.Create('RLE compression is not supported');
  6576. end;
  6577. BMP_COMP_BITFIELDS: begin
  6578. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  6579. aStream.Read(aMask.r, SizeOf(aMask.r));
  6580. aStream.Read(aMask.g, SizeOf(aMask.g));
  6581. aStream.Read(aMask.b, SizeOf(aMask.b));
  6582. aStream.Read(aMask.a, SizeOf(aMask.a));
  6583. end else
  6584. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  6585. end;
  6586. end;
  6587. //get suitable format
  6588. case aInfo.biBitCount of
  6589. 8: result := tfLuminance8ub1;
  6590. 16: result := tfX1RGB5us1;
  6591. 24: result := tfBGR8ub3;
  6592. 32: result := tfXRGB8ui1;
  6593. end;
  6594. end;
  6595. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  6596. var
  6597. i, c: Integer;
  6598. ColorTable: TbmpColorTable;
  6599. begin
  6600. result := nil;
  6601. if (aInfo.biBitCount >= 16) then
  6602. exit;
  6603. aFormat := tfLuminance8ub1;
  6604. c := aInfo.biClrUsed;
  6605. if (c = 0) then
  6606. c := 1 shl aInfo.biBitCount;
  6607. SetLength(ColorTable, c);
  6608. for i := 0 to c-1 do begin
  6609. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  6610. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  6611. aFormat := tfRGB8ub3;
  6612. end;
  6613. result := TbmpColorTableFormat.Create;
  6614. result.BitsPerPixel := aInfo.biBitCount;
  6615. result.ColorTable := ColorTable;
  6616. result.CalcValues;
  6617. end;
  6618. //////////////////////////////////////////////////////////////////////////////////////////////////
  6619. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
  6620. var
  6621. FormatDesc: TFormatDescriptor;
  6622. begin
  6623. result := nil;
  6624. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  6625. FormatDesc := TFormatDescriptor.GetFromMask(aMask);
  6626. if (FormatDesc.Format = tfEmpty) then
  6627. exit;
  6628. aFormat := FormatDesc.Format;
  6629. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  6630. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  6631. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  6632. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  6633. result := TbmpBitfieldFormat.Create;
  6634. result.SetCustomValues(aInfo.biBitCount, aMask);
  6635. end;
  6636. end;
  6637. var
  6638. //simple types
  6639. StartPos: Int64;
  6640. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  6641. PaddingBuff: Cardinal;
  6642. LineBuf, ImageData, TmpData: PByte;
  6643. SourceMD, DestMD: Pointer;
  6644. BmpFormat: TglBitmapFormat;
  6645. //records
  6646. Mask: TglBitmapRec4ul;
  6647. Header: TBMPHeader;
  6648. Info: TBMPInfo;
  6649. //classes
  6650. SpecialFormat: TFormatDescriptor;
  6651. FormatDesc: TFormatDescriptor;
  6652. //////////////////////////////////////////////////////////////////////////////////////////////////
  6653. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  6654. var
  6655. i: Integer;
  6656. Pixel: TglBitmapPixelData;
  6657. begin
  6658. aStream.Read(aLineBuf^, rbLineSize);
  6659. SpecialFormat.PreparePixel(Pixel);
  6660. for i := 0 to Info.biWidth-1 do begin
  6661. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  6662. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  6663. FormatDesc.Map(Pixel, aData, DestMD);
  6664. end;
  6665. end;
  6666. begin
  6667. result := false;
  6668. BmpFormat := tfEmpty;
  6669. SpecialFormat := nil;
  6670. LineBuf := nil;
  6671. SourceMD := nil;
  6672. DestMD := nil;
  6673. // Header
  6674. StartPos := aStream.Position;
  6675. aStream.Read(Header{%H-}, SizeOf(Header));
  6676. if Header.bfType = BMP_MAGIC then begin
  6677. try try
  6678. BmpFormat := ReadInfo(Info, Mask);
  6679. SpecialFormat := ReadColorTable(BmpFormat, Info);
  6680. if not Assigned(SpecialFormat) then
  6681. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  6682. aStream.Position := StartPos + Header.bfOffBits;
  6683. if (BmpFormat <> tfEmpty) then begin
  6684. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  6685. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  6686. wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
  6687. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  6688. //get Memory
  6689. DestMD := FormatDesc.CreateMappingData;
  6690. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  6691. GetMem(ImageData, ImageSize);
  6692. if Assigned(SpecialFormat) then begin
  6693. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  6694. SourceMD := SpecialFormat.CreateMappingData;
  6695. end;
  6696. //read Data
  6697. try try
  6698. FillChar(ImageData^, ImageSize, $FF);
  6699. TmpData := ImageData;
  6700. if (Info.biHeight > 0) then
  6701. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  6702. for i := 0 to Abs(Info.biHeight)-1 do begin
  6703. if Assigned(SpecialFormat) then
  6704. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  6705. else
  6706. aStream.Read(TmpData^, wbLineSize); //else only read data
  6707. if (Info.biHeight > 0) then
  6708. dec(TmpData, wbLineSize)
  6709. else
  6710. inc(TmpData, wbLineSize);
  6711. aStream.Read(PaddingBuff{%H-}, Padding);
  6712. end;
  6713. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6714. result := true;
  6715. finally
  6716. if Assigned(LineBuf) then
  6717. FreeMem(LineBuf);
  6718. if Assigned(SourceMD) then
  6719. SpecialFormat.FreeMappingData(SourceMD);
  6720. FormatDesc.FreeMappingData(DestMD);
  6721. end;
  6722. except
  6723. if Assigned(ImageData) then
  6724. FreeMem(ImageData);
  6725. raise;
  6726. end;
  6727. end else
  6728. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6729. except
  6730. aStream.Position := StartPos;
  6731. raise;
  6732. end;
  6733. finally
  6734. FreeAndNil(SpecialFormat);
  6735. end;
  6736. end
  6737. else aStream.Position := StartPos;
  6738. end;
  6739. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6740. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6741. var
  6742. Header: TBMPHeader;
  6743. Info: TBMPInfo;
  6744. Converter: TFormatDescriptor;
  6745. FormatDesc: TFormatDescriptor;
  6746. SourceFD, DestFD: Pointer;
  6747. pData, srcData, dstData, ConvertBuffer: pByte;
  6748. Pixel: TglBitmapPixelData;
  6749. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6750. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6751. PaddingBuff: Cardinal;
  6752. function GetLineWidth : Integer;
  6753. begin
  6754. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6755. end;
  6756. begin
  6757. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6758. raise EglBitmapUnsupportedFormat.Create(Format);
  6759. Converter := nil;
  6760. FormatDesc := TFormatDescriptor.Get(Format);
  6761. ImageSize := FormatDesc.GetSize(Dimension);
  6762. FillChar(Header{%H-}, SizeOf(Header), 0);
  6763. Header.bfType := BMP_MAGIC;
  6764. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6765. Header.bfReserved1 := 0;
  6766. Header.bfReserved2 := 0;
  6767. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6768. FillChar(Info{%H-}, SizeOf(Info), 0);
  6769. Info.biSize := SizeOf(Info);
  6770. Info.biWidth := Width;
  6771. Info.biHeight := Height;
  6772. Info.biPlanes := 1;
  6773. Info.biCompression := BMP_COMP_RGB;
  6774. Info.biSizeImage := ImageSize;
  6775. try
  6776. case Format of
  6777. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
  6778. begin
  6779. Info.biBitCount := 8;
  6780. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6781. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6782. Converter := TbmpColorTableFormat.Create;
  6783. with (Converter as TbmpColorTableFormat) do begin
  6784. SetCustomValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift);
  6785. CreateColorTable;
  6786. end;
  6787. end;
  6788. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  6789. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  6790. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
  6791. begin
  6792. Info.biBitCount := 16;
  6793. Info.biCompression := BMP_COMP_BITFIELDS;
  6794. end;
  6795. tfBGR8ub3, tfRGB8ub3:
  6796. begin
  6797. Info.biBitCount := 24;
  6798. if (Format = tfRGB8ub3) then
  6799. Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6800. end;
  6801. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  6802. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
  6803. begin
  6804. Info.biBitCount := 32;
  6805. Info.biCompression := BMP_COMP_BITFIELDS;
  6806. end;
  6807. else
  6808. raise EglBitmapUnsupportedFormat.Create(Format);
  6809. end;
  6810. Info.biXPelsPerMeter := 2835;
  6811. Info.biYPelsPerMeter := 2835;
  6812. // prepare bitmasks
  6813. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6814. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6815. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6816. RedMask := FormatDesc.Mask.r;
  6817. GreenMask := FormatDesc.Mask.g;
  6818. BlueMask := FormatDesc.Mask.b;
  6819. AlphaMask := FormatDesc.Mask.a;
  6820. end;
  6821. // headers
  6822. aStream.Write(Header, SizeOf(Header));
  6823. aStream.Write(Info, SizeOf(Info));
  6824. // colortable
  6825. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6826. with (Converter as TbmpColorTableFormat) do
  6827. aStream.Write(ColorTable[0].b,
  6828. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6829. // bitmasks
  6830. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6831. aStream.Write(RedMask, SizeOf(Cardinal));
  6832. aStream.Write(GreenMask, SizeOf(Cardinal));
  6833. aStream.Write(BlueMask, SizeOf(Cardinal));
  6834. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6835. end;
  6836. // image data
  6837. rbLineSize := Round(Info.biWidth * FormatDesc.BytesPerPixel);
  6838. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6839. Padding := GetLineWidth - wbLineSize;
  6840. PaddingBuff := 0;
  6841. pData := Data;
  6842. inc(pData, (Height-1) * rbLineSize);
  6843. // prepare row buffer. But only for RGB because RGBA supports color masks
  6844. // so it's possible to change color within the image.
  6845. if Assigned(Converter) then begin
  6846. FormatDesc.PreparePixel(Pixel);
  6847. GetMem(ConvertBuffer, wbLineSize);
  6848. SourceFD := FormatDesc.CreateMappingData;
  6849. DestFD := Converter.CreateMappingData;
  6850. end else
  6851. ConvertBuffer := nil;
  6852. try
  6853. for LineIdx := 0 to Height - 1 do begin
  6854. // preparing row
  6855. if Assigned(Converter) then begin
  6856. srcData := pData;
  6857. dstData := ConvertBuffer;
  6858. for PixelIdx := 0 to Info.biWidth-1 do begin
  6859. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6860. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6861. Converter.Map(Pixel, dstData, DestFD);
  6862. end;
  6863. aStream.Write(ConvertBuffer^, wbLineSize);
  6864. end else begin
  6865. aStream.Write(pData^, rbLineSize);
  6866. end;
  6867. dec(pData, rbLineSize);
  6868. if (Padding > 0) then
  6869. aStream.Write(PaddingBuff, Padding);
  6870. end;
  6871. finally
  6872. // destroy row buffer
  6873. if Assigned(ConvertBuffer) then begin
  6874. FormatDesc.FreeMappingData(SourceFD);
  6875. Converter.FreeMappingData(DestFD);
  6876. FreeMem(ConvertBuffer);
  6877. end;
  6878. end;
  6879. finally
  6880. if Assigned(Converter) then
  6881. Converter.Free;
  6882. end;
  6883. end;
  6884. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6885. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6886. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6887. type
  6888. TTGAHeader = packed record
  6889. ImageID: Byte;
  6890. ColorMapType: Byte;
  6891. ImageType: Byte;
  6892. //ColorMapSpec: Array[0..4] of Byte;
  6893. ColorMapStart: Word;
  6894. ColorMapLength: Word;
  6895. ColorMapEntrySize: Byte;
  6896. OrigX: Word;
  6897. OrigY: Word;
  6898. Width: Word;
  6899. Height: Word;
  6900. Bpp: Byte;
  6901. ImageDesc: Byte;
  6902. end;
  6903. const
  6904. TGA_UNCOMPRESSED_RGB = 2;
  6905. TGA_UNCOMPRESSED_GRAY = 3;
  6906. TGA_COMPRESSED_RGB = 10;
  6907. TGA_COMPRESSED_GRAY = 11;
  6908. TGA_NONE_COLOR_TABLE = 0;
  6909. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6910. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6911. var
  6912. Header: TTGAHeader;
  6913. ImageData: System.PByte;
  6914. StartPosition: Int64;
  6915. PixelSize, LineSize: Integer;
  6916. tgaFormat: TglBitmapFormat;
  6917. FormatDesc: TFormatDescriptor;
  6918. Counter: packed record
  6919. X, Y: packed record
  6920. low, high, dir: Integer;
  6921. end;
  6922. end;
  6923. const
  6924. CACHE_SIZE = $4000;
  6925. ////////////////////////////////////////////////////////////////////////////////////////
  6926. procedure ReadUncompressed;
  6927. var
  6928. i, j: Integer;
  6929. buf, tmp1, tmp2: System.PByte;
  6930. begin
  6931. buf := nil;
  6932. if (Counter.X.dir < 0) then
  6933. GetMem(buf, LineSize);
  6934. try
  6935. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6936. tmp1 := ImageData;
  6937. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6938. if (Counter.X.dir < 0) then begin //flip X
  6939. aStream.Read(buf^, LineSize);
  6940. tmp2 := buf;
  6941. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6942. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6943. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6944. tmp1^ := tmp2^;
  6945. inc(tmp1);
  6946. inc(tmp2);
  6947. end;
  6948. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6949. end;
  6950. end else
  6951. aStream.Read(tmp1^, LineSize);
  6952. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6953. end;
  6954. finally
  6955. if Assigned(buf) then
  6956. FreeMem(buf);
  6957. end;
  6958. end;
  6959. ////////////////////////////////////////////////////////////////////////////////////////
  6960. procedure ReadCompressed;
  6961. /////////////////////////////////////////////////////////////////
  6962. var
  6963. TmpData: System.PByte;
  6964. LinePixelsRead: Integer;
  6965. procedure CheckLine;
  6966. begin
  6967. if (LinePixelsRead >= Header.Width) then begin
  6968. LinePixelsRead := 0;
  6969. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6970. TmpData := ImageData;
  6971. inc(TmpData, Counter.Y.low * LineSize); //set line
  6972. if (Counter.X.dir < 0) then //if x flipped then
  6973. inc(TmpData, LineSize - PixelSize); //set last pixel
  6974. end;
  6975. end;
  6976. /////////////////////////////////////////////////////////////////
  6977. var
  6978. Cache: PByte;
  6979. CacheSize, CachePos: Integer;
  6980. procedure CachedRead(out Buffer; Count: Integer);
  6981. var
  6982. BytesRead: Integer;
  6983. begin
  6984. if (CachePos + Count > CacheSize) then begin
  6985. //if buffer overflow save non read bytes
  6986. BytesRead := 0;
  6987. if (CacheSize - CachePos > 0) then begin
  6988. BytesRead := CacheSize - CachePos;
  6989. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6990. inc(CachePos, BytesRead);
  6991. end;
  6992. //load cache from file
  6993. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6994. aStream.Read(Cache^, CacheSize);
  6995. CachePos := 0;
  6996. //read rest of requested bytes
  6997. if (Count - BytesRead > 0) then begin
  6998. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6999. inc(CachePos, Count - BytesRead);
  7000. end;
  7001. end else begin
  7002. //if no buffer overflow just read the data
  7003. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  7004. inc(CachePos, Count);
  7005. end;
  7006. end;
  7007. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  7008. begin
  7009. case PixelSize of
  7010. 1: begin
  7011. aBuffer^ := aData^;
  7012. inc(aBuffer, Counter.X.dir);
  7013. end;
  7014. 2: begin
  7015. PWord(aBuffer)^ := PWord(aData)^;
  7016. inc(aBuffer, 2 * Counter.X.dir);
  7017. end;
  7018. 3: begin
  7019. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  7020. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  7021. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  7022. inc(aBuffer, 3 * Counter.X.dir);
  7023. end;
  7024. 4: begin
  7025. PCardinal(aBuffer)^ := PCardinal(aData)^;
  7026. inc(aBuffer, 4 * Counter.X.dir);
  7027. end;
  7028. end;
  7029. end;
  7030. var
  7031. TotalPixelsToRead, TotalPixelsRead: Integer;
  7032. Temp: Byte;
  7033. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  7034. PixelRepeat: Boolean;
  7035. PixelsToRead, PixelCount: Integer;
  7036. begin
  7037. CacheSize := 0;
  7038. CachePos := 0;
  7039. TotalPixelsToRead := Header.Width * Header.Height;
  7040. TotalPixelsRead := 0;
  7041. LinePixelsRead := 0;
  7042. GetMem(Cache, CACHE_SIZE);
  7043. try
  7044. TmpData := ImageData;
  7045. inc(TmpData, Counter.Y.low * LineSize); //set line
  7046. if (Counter.X.dir < 0) then //if x flipped then
  7047. inc(TmpData, LineSize - PixelSize); //set last pixel
  7048. repeat
  7049. //read CommandByte
  7050. CachedRead(Temp, 1);
  7051. PixelRepeat := (Temp and $80) > 0;
  7052. PixelsToRead := (Temp and $7F) + 1;
  7053. inc(TotalPixelsRead, PixelsToRead);
  7054. if PixelRepeat then
  7055. CachedRead(buf[0], PixelSize);
  7056. while (PixelsToRead > 0) do begin
  7057. CheckLine;
  7058. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  7059. while (PixelCount > 0) do begin
  7060. if not PixelRepeat then
  7061. CachedRead(buf[0], PixelSize);
  7062. PixelToBuffer(@buf[0], TmpData);
  7063. inc(LinePixelsRead);
  7064. dec(PixelsToRead);
  7065. dec(PixelCount);
  7066. end;
  7067. end;
  7068. until (TotalPixelsRead >= TotalPixelsToRead);
  7069. finally
  7070. FreeMem(Cache);
  7071. end;
  7072. end;
  7073. function IsGrayFormat: Boolean;
  7074. begin
  7075. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  7076. end;
  7077. begin
  7078. result := false;
  7079. // reading header to test file and set cursor back to begin
  7080. StartPosition := aStream.Position;
  7081. aStream.Read(Header{%H-}, SizeOf(Header));
  7082. // no colormapped files
  7083. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  7084. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  7085. begin
  7086. try
  7087. if Header.ImageID <> 0 then // skip image ID
  7088. aStream.Position := aStream.Position + Header.ImageID;
  7089. tgaFormat := tfEmpty;
  7090. case Header.Bpp of
  7091. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  7092. 0: tgaFormat := tfLuminance8ub1;
  7093. 8: tgaFormat := tfAlpha8ub1;
  7094. end;
  7095. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  7096. 0: tgaFormat := tfLuminance16us1;
  7097. 8: tgaFormat := tfLuminance8Alpha8ub2;
  7098. end else case (Header.ImageDesc and $F) of
  7099. 0: tgaFormat := tfX1RGB5us1;
  7100. 1: tgaFormat := tfA1RGB5us1;
  7101. 4: tgaFormat := tfARGB4us1;
  7102. end;
  7103. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  7104. 0: tgaFormat := tfBGR8ub3;
  7105. end;
  7106. 32: if IsGrayFormat then case (Header.ImageDesc and $F) of
  7107. 0: tgaFormat := tfDepth32ui1;
  7108. end else case (Header.ImageDesc and $F) of
  7109. 0: tgaFormat := tfX2RGB10ui1;
  7110. 2: tgaFormat := tfA2RGB10ui1;
  7111. 8: tgaFormat := tfARGB8ui1;
  7112. end;
  7113. end;
  7114. if (tgaFormat = tfEmpty) then
  7115. raise EglBitmap.Create('LoadTga - unsupported format');
  7116. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  7117. PixelSize := FormatDesc.GetSize(1, 1);
  7118. LineSize := FormatDesc.GetSize(Header.Width, 1);
  7119. GetMem(ImageData, LineSize * Header.Height);
  7120. try
  7121. //column direction
  7122. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  7123. Counter.X.low := Header.Height-1;;
  7124. Counter.X.high := 0;
  7125. Counter.X.dir := -1;
  7126. end else begin
  7127. Counter.X.low := 0;
  7128. Counter.X.high := Header.Height-1;
  7129. Counter.X.dir := 1;
  7130. end;
  7131. // Row direction
  7132. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  7133. Counter.Y.low := 0;
  7134. Counter.Y.high := Header.Height-1;
  7135. Counter.Y.dir := 1;
  7136. end else begin
  7137. Counter.Y.low := Header.Height-1;;
  7138. Counter.Y.high := 0;
  7139. Counter.Y.dir := -1;
  7140. end;
  7141. // Read Image
  7142. case Header.ImageType of
  7143. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  7144. ReadUncompressed;
  7145. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  7146. ReadCompressed;
  7147. end;
  7148. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  7149. result := true;
  7150. except
  7151. if Assigned(ImageData) then
  7152. FreeMem(ImageData);
  7153. raise;
  7154. end;
  7155. finally
  7156. aStream.Position := StartPosition;
  7157. end;
  7158. end
  7159. else aStream.Position := StartPosition;
  7160. end;
  7161. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7162. procedure TglBitmap.SaveTGA(const aStream: TStream);
  7163. var
  7164. Header: TTGAHeader;
  7165. Size: Integer;
  7166. FormatDesc: TFormatDescriptor;
  7167. begin
  7168. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  7169. raise EglBitmapUnsupportedFormat.Create(Format);
  7170. //prepare header
  7171. FormatDesc := TFormatDescriptor.Get(Format);
  7172. FillChar(Header{%H-}, SizeOf(Header), 0);
  7173. Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
  7174. Header.Bpp := FormatDesc.BitsPerPixel;
  7175. Header.Width := Width;
  7176. Header.Height := Height;
  7177. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  7178. if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
  7179. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  7180. else
  7181. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  7182. aStream.Write(Header, SizeOf(Header));
  7183. // write Data
  7184. Size := FormatDesc.GetSize(Dimension);
  7185. aStream.Write(Data^, Size);
  7186. end;
  7187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7188. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7189. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7190. const
  7191. DDS_MAGIC: Cardinal = $20534444;
  7192. // DDS_header.dwFlags
  7193. DDSD_CAPS = $00000001;
  7194. DDSD_HEIGHT = $00000002;
  7195. DDSD_WIDTH = $00000004;
  7196. DDSD_PIXELFORMAT = $00001000;
  7197. // DDS_header.sPixelFormat.dwFlags
  7198. DDPF_ALPHAPIXELS = $00000001;
  7199. DDPF_ALPHA = $00000002;
  7200. DDPF_FOURCC = $00000004;
  7201. DDPF_RGB = $00000040;
  7202. DDPF_LUMINANCE = $00020000;
  7203. // DDS_header.sCaps.dwCaps1
  7204. DDSCAPS_TEXTURE = $00001000;
  7205. // DDS_header.sCaps.dwCaps2
  7206. DDSCAPS2_CUBEMAP = $00000200;
  7207. D3DFMT_DXT1 = $31545844;
  7208. D3DFMT_DXT3 = $33545844;
  7209. D3DFMT_DXT5 = $35545844;
  7210. type
  7211. TDDSPixelFormat = packed record
  7212. dwSize: Cardinal;
  7213. dwFlags: Cardinal;
  7214. dwFourCC: Cardinal;
  7215. dwRGBBitCount: Cardinal;
  7216. dwRBitMask: Cardinal;
  7217. dwGBitMask: Cardinal;
  7218. dwBBitMask: Cardinal;
  7219. dwABitMask: Cardinal;
  7220. end;
  7221. TDDSCaps = packed record
  7222. dwCaps1: Cardinal;
  7223. dwCaps2: Cardinal;
  7224. dwDDSX: Cardinal;
  7225. dwReserved: Cardinal;
  7226. end;
  7227. TDDSHeader = packed record
  7228. dwSize: Cardinal;
  7229. dwFlags: Cardinal;
  7230. dwHeight: Cardinal;
  7231. dwWidth: Cardinal;
  7232. dwPitchOrLinearSize: Cardinal;
  7233. dwDepth: Cardinal;
  7234. dwMipMapCount: Cardinal;
  7235. dwReserved: array[0..10] of Cardinal;
  7236. PixelFormat: TDDSPixelFormat;
  7237. Caps: TDDSCaps;
  7238. dwReserved2: Cardinal;
  7239. end;
  7240. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7241. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  7242. var
  7243. Header: TDDSHeader;
  7244. Converter: TbmpBitfieldFormat;
  7245. function GetDDSFormat: TglBitmapFormat;
  7246. var
  7247. fd: TFormatDescriptor;
  7248. i: Integer;
  7249. Mask: TglBitmapRec4ul;
  7250. Range: TglBitmapRec4ui;
  7251. match: Boolean;
  7252. begin
  7253. result := tfEmpty;
  7254. with Header.PixelFormat do begin
  7255. // Compresses
  7256. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  7257. case Header.PixelFormat.dwFourCC of
  7258. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  7259. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  7260. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  7261. end;
  7262. end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
  7263. // prepare masks
  7264. if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
  7265. Mask.r := dwRBitMask;
  7266. Mask.g := dwGBitMask;
  7267. Mask.b := dwBBitMask;
  7268. end else begin
  7269. Mask.r := dwRBitMask;
  7270. Mask.g := dwRBitMask;
  7271. Mask.b := dwRBitMask;
  7272. end;
  7273. if (dwFlags and DDPF_ALPHAPIXELS > 0) then
  7274. Mask.a := dwABitMask
  7275. else
  7276. Mask.a := 0;;
  7277. //find matching format
  7278. fd := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
  7279. result := fd.Format;
  7280. if (result <> tfEmpty) then
  7281. exit;
  7282. //find format with same Range
  7283. for i := 0 to 3 do
  7284. Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
  7285. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  7286. fd := TFormatDescriptor.Get(result);
  7287. match := true;
  7288. for i := 0 to 3 do
  7289. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  7290. match := false;
  7291. break;
  7292. end;
  7293. if match then
  7294. break;
  7295. end;
  7296. //no format with same range found -> use default
  7297. if (result = tfEmpty) then begin
  7298. if (dwABitMask > 0) then
  7299. result := tfRGBA8ui1
  7300. else
  7301. result := tfRGB8ub3;
  7302. end;
  7303. Converter := TbmpBitfieldFormat.Create;
  7304. Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
  7305. end;
  7306. end;
  7307. end;
  7308. var
  7309. StreamPos: Int64;
  7310. x, y, LineSize, RowSize, Magic: Cardinal;
  7311. NewImage, TmpData, RowData, SrcData: System.PByte;
  7312. SourceMD, DestMD: Pointer;
  7313. Pixel: TglBitmapPixelData;
  7314. ddsFormat: TglBitmapFormat;
  7315. FormatDesc: TFormatDescriptor;
  7316. begin
  7317. result := false;
  7318. Converter := nil;
  7319. StreamPos := aStream.Position;
  7320. // Magic
  7321. aStream.Read(Magic{%H-}, sizeof(Magic));
  7322. if (Magic <> DDS_MAGIC) then begin
  7323. aStream.Position := StreamPos;
  7324. exit;
  7325. end;
  7326. //Header
  7327. aStream.Read(Header{%H-}, sizeof(Header));
  7328. if (Header.dwSize <> SizeOf(Header)) or
  7329. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  7330. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  7331. begin
  7332. aStream.Position := StreamPos;
  7333. exit;
  7334. end;
  7335. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  7336. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  7337. ddsFormat := GetDDSFormat;
  7338. try
  7339. if (ddsFormat = tfEmpty) then
  7340. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  7341. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  7342. LineSize := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
  7343. GetMem(NewImage, Header.dwHeight * LineSize);
  7344. try
  7345. TmpData := NewImage;
  7346. //Converter needed
  7347. if Assigned(Converter) then begin
  7348. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  7349. GetMem(RowData, RowSize);
  7350. SourceMD := Converter.CreateMappingData;
  7351. DestMD := FormatDesc.CreateMappingData;
  7352. try
  7353. for y := 0 to Header.dwHeight-1 do begin
  7354. TmpData := NewImage;
  7355. inc(TmpData, y * LineSize);
  7356. SrcData := RowData;
  7357. aStream.Read(SrcData^, RowSize);
  7358. for x := 0 to Header.dwWidth-1 do begin
  7359. Converter.Unmap(SrcData, Pixel, SourceMD);
  7360. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  7361. FormatDesc.Map(Pixel, TmpData, DestMD);
  7362. end;
  7363. end;
  7364. finally
  7365. Converter.FreeMappingData(SourceMD);
  7366. FormatDesc.FreeMappingData(DestMD);
  7367. FreeMem(RowData);
  7368. end;
  7369. end else
  7370. // Compressed
  7371. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  7372. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  7373. for Y := 0 to Header.dwHeight-1 do begin
  7374. aStream.Read(TmpData^, RowSize);
  7375. Inc(TmpData, LineSize);
  7376. end;
  7377. end else
  7378. // Uncompressed
  7379. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  7380. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  7381. for Y := 0 to Header.dwHeight-1 do begin
  7382. aStream.Read(TmpData^, RowSize);
  7383. Inc(TmpData, LineSize);
  7384. end;
  7385. end else
  7386. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  7387. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  7388. result := true;
  7389. except
  7390. if Assigned(NewImage) then
  7391. FreeMem(NewImage);
  7392. raise;
  7393. end;
  7394. finally
  7395. FreeAndNil(Converter);
  7396. end;
  7397. end;
  7398. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7399. procedure TglBitmap.SaveDDS(const aStream: TStream);
  7400. var
  7401. Header: TDDSHeader;
  7402. FormatDesc: TFormatDescriptor;
  7403. begin
  7404. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  7405. raise EglBitmapUnsupportedFormat.Create(Format);
  7406. FormatDesc := TFormatDescriptor.Get(Format);
  7407. // Generell
  7408. FillChar(Header{%H-}, SizeOf(Header), 0);
  7409. Header.dwSize := SizeOf(Header);
  7410. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  7411. Header.dwWidth := Max(1, Width);
  7412. Header.dwHeight := Max(1, Height);
  7413. // Caps
  7414. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  7415. // Pixelformat
  7416. Header.PixelFormat.dwSize := sizeof(Header);
  7417. if (FormatDesc.IsCompressed) then begin
  7418. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  7419. case Format of
  7420. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  7421. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  7422. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  7423. end;
  7424. end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
  7425. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  7426. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7427. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7428. end else if FormatDesc.IsGrayscale then begin
  7429. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  7430. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7431. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  7432. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7433. end else begin
  7434. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  7435. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7436. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  7437. Header.PixelFormat.dwGBitMask := FormatDesc.Mask.g;
  7438. Header.PixelFormat.dwBBitMask := FormatDesc.Mask.b;
  7439. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7440. end;
  7441. if (FormatDesc.HasAlpha) then
  7442. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  7443. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  7444. aStream.Write(Header, SizeOf(Header));
  7445. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  7446. end;
  7447. {$IFNDEF OPENGL_ES}
  7448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7449. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7450. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7451. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7452. const aWidth: Integer; const aHeight: Integer);
  7453. var
  7454. pTemp: pByte;
  7455. Size: Integer;
  7456. begin
  7457. if (aHeight > 1) then begin
  7458. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  7459. GetMem(pTemp, Size);
  7460. try
  7461. Move(aData^, pTemp^, Size);
  7462. FreeMem(aData);
  7463. aData := nil;
  7464. except
  7465. FreeMem(pTemp);
  7466. raise;
  7467. end;
  7468. end else
  7469. pTemp := aData;
  7470. inherited SetDataPointer(pTemp, aFormat, aWidth);
  7471. end;
  7472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7473. function TglBitmap1D.FlipHorz: Boolean;
  7474. var
  7475. Col: Integer;
  7476. pTempDest, pDest, pSource: PByte;
  7477. begin
  7478. result := inherited FlipHorz;
  7479. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  7480. pSource := Data;
  7481. GetMem(pDest, fRowSize);
  7482. try
  7483. pTempDest := pDest;
  7484. Inc(pTempDest, fRowSize);
  7485. for Col := 0 to Width-1 do begin
  7486. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  7487. Move(pSource^, pTempDest^, fPixelSize);
  7488. Inc(pSource, fPixelSize);
  7489. end;
  7490. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  7491. result := true;
  7492. except
  7493. if Assigned(pDest) then
  7494. FreeMem(pDest);
  7495. raise;
  7496. end;
  7497. end;
  7498. end;
  7499. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7500. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  7501. var
  7502. FormatDesc: TFormatDescriptor;
  7503. begin
  7504. // Upload data
  7505. FormatDesc := TFormatDescriptor.Get(Format);
  7506. if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
  7507. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7508. if FormatDesc.IsCompressed then begin
  7509. if not Assigned(glCompressedTexImage1D) then
  7510. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7511. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  7512. end else if aBuildWithGlu then
  7513. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7514. else
  7515. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7516. // Free Data
  7517. if (FreeDataAfterGenTexture) then
  7518. FreeData;
  7519. end;
  7520. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7521. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  7522. var
  7523. BuildWithGlu, TexRec: Boolean;
  7524. TexSize: Integer;
  7525. begin
  7526. if Assigned(Data) then begin
  7527. // Check Texture Size
  7528. if (aTestTextureSize) then begin
  7529. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7530. if (Width > TexSize) then
  7531. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7532. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7533. (Target = GL_TEXTURE_RECTANGLE);
  7534. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7535. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7536. end;
  7537. CreateId;
  7538. SetupParameters(BuildWithGlu);
  7539. UploadData(BuildWithGlu);
  7540. glAreTexturesResident(1, @fID, @fIsResident);
  7541. end;
  7542. end;
  7543. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7544. procedure TglBitmap1D.AfterConstruction;
  7545. begin
  7546. inherited;
  7547. Target := GL_TEXTURE_1D;
  7548. end;
  7549. {$ENDIF}
  7550. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7551. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7552. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7553. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  7554. begin
  7555. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  7556. result := fLines[aIndex]
  7557. else
  7558. result := nil;
  7559. end;
  7560. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7561. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7562. const aWidth: Integer; const aHeight: Integer);
  7563. var
  7564. Idx, LineWidth: Integer;
  7565. begin
  7566. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  7567. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  7568. // Assigning Data
  7569. if Assigned(Data) then begin
  7570. SetLength(fLines, GetHeight);
  7571. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel);
  7572. for Idx := 0 to GetHeight-1 do begin
  7573. fLines[Idx] := Data;
  7574. Inc(fLines[Idx], Idx * LineWidth);
  7575. end;
  7576. end
  7577. else SetLength(fLines, 0);
  7578. end else begin
  7579. SetLength(fLines, 0);
  7580. end;
  7581. end;
  7582. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7583. procedure TglBitmap2D.UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
  7584. var
  7585. FormatDesc: TFormatDescriptor;
  7586. begin
  7587. FormatDesc := TFormatDescriptor.Get(Format);
  7588. if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then
  7589. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7590. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7591. if FormatDesc.IsCompressed then begin
  7592. if not Assigned(glCompressedTexImage2D) then
  7593. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7594. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  7595. {$IFNDEF OPENGL_ES}
  7596. end else if aBuildWithGlu then begin
  7597. gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height,
  7598. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7599. {$ENDIF}
  7600. end else begin
  7601. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  7602. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7603. end;
  7604. // Freigeben
  7605. if (FreeDataAfterGenTexture) then
  7606. FreeData;
  7607. end;
  7608. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7609. procedure TglBitmap2D.AfterConstruction;
  7610. begin
  7611. inherited;
  7612. Target := GL_TEXTURE_2D;
  7613. end;
  7614. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7615. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  7616. var
  7617. Temp: pByte;
  7618. Size, w, h: Integer;
  7619. FormatDesc: TFormatDescriptor;
  7620. begin
  7621. FormatDesc := TFormatDescriptor.Get(aFormat);
  7622. if FormatDesc.IsCompressed then
  7623. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7624. w := aRight - aLeft;
  7625. h := aBottom - aTop;
  7626. Size := FormatDesc.GetSize(w, h);
  7627. GetMem(Temp, Size);
  7628. try
  7629. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7630. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7631. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  7632. FlipVert;
  7633. except
  7634. if Assigned(Temp) then
  7635. FreeMem(Temp);
  7636. raise;
  7637. end;
  7638. end;
  7639. {$IFNDEF OPENGL_ES}
  7640. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7641. procedure TglBitmap2D.GetDataFromTexture;
  7642. var
  7643. Temp: PByte;
  7644. TempWidth, TempHeight: Integer;
  7645. TempIntFormat: GLint;
  7646. IntFormat: TglBitmapFormat;
  7647. FormatDesc: TFormatDescriptor;
  7648. begin
  7649. Bind;
  7650. // Request Data
  7651. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7652. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7653. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7654. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7655. IntFormat := FormatDesc.Format;
  7656. // Getting data from OpenGL
  7657. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7658. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7659. try
  7660. if FormatDesc.IsCompressed then begin
  7661. if not Assigned(glGetCompressedTexImage) then
  7662. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7663. glGetCompressedTexImage(Target, 0, Temp)
  7664. end else
  7665. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7666. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7667. except
  7668. if Assigned(Temp) then
  7669. FreeMem(Temp);
  7670. raise;
  7671. end;
  7672. end;
  7673. {$ENDIF}
  7674. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7675. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7676. var
  7677. {$IFNDEF OPENGL_ES}
  7678. BuildWithGlu, TexRec: Boolean;
  7679. {$ENDIF}
  7680. PotTex: Boolean;
  7681. TexSize: Integer;
  7682. begin
  7683. if Assigned(Data) then begin
  7684. // Check Texture Size
  7685. if (aTestTextureSize) then begin
  7686. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7687. if ((Height > TexSize) or (Width > TexSize)) then
  7688. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7689. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7690. {$IF NOT DEFINED(OPENGL_ES)}
  7691. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7692. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7693. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7694. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7695. if not PotTex and not GL_OES_texture_npot then
  7696. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7697. {$ELSE}
  7698. if not PotTex then
  7699. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7700. {$IFEND}
  7701. end;
  7702. CreateId;
  7703. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7704. UploadData(Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7705. {$IFNDEF OPENGL_ES}
  7706. glAreTexturesResident(1, @fID, @fIsResident);
  7707. {$ENDIF}
  7708. end;
  7709. end;
  7710. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7711. function TglBitmap2D.FlipHorz: Boolean;
  7712. var
  7713. Col, Row: Integer;
  7714. TempDestData, DestData, SourceData: PByte;
  7715. ImgSize: Integer;
  7716. begin
  7717. result := inherited FlipHorz;
  7718. if Assigned(Data) then begin
  7719. SourceData := Data;
  7720. ImgSize := Height * fRowSize;
  7721. GetMem(DestData, ImgSize);
  7722. try
  7723. TempDestData := DestData;
  7724. Dec(TempDestData, fRowSize + fPixelSize);
  7725. for Row := 0 to Height -1 do begin
  7726. Inc(TempDestData, fRowSize * 2);
  7727. for Col := 0 to Width -1 do begin
  7728. Move(SourceData^, TempDestData^, fPixelSize);
  7729. Inc(SourceData, fPixelSize);
  7730. Dec(TempDestData, fPixelSize);
  7731. end;
  7732. end;
  7733. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7734. result := true;
  7735. except
  7736. if Assigned(DestData) then
  7737. FreeMem(DestData);
  7738. raise;
  7739. end;
  7740. end;
  7741. end;
  7742. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7743. function TglBitmap2D.FlipVert: Boolean;
  7744. var
  7745. Row: Integer;
  7746. TempDestData, DestData, SourceData: PByte;
  7747. begin
  7748. result := inherited FlipVert;
  7749. if Assigned(Data) then begin
  7750. SourceData := Data;
  7751. GetMem(DestData, Height * fRowSize);
  7752. try
  7753. TempDestData := DestData;
  7754. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7755. for Row := 0 to Height -1 do begin
  7756. Move(SourceData^, TempDestData^, fRowSize);
  7757. Dec(TempDestData, fRowSize);
  7758. Inc(SourceData, fRowSize);
  7759. end;
  7760. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7761. result := true;
  7762. except
  7763. if Assigned(DestData) then
  7764. FreeMem(DestData);
  7765. raise;
  7766. end;
  7767. end;
  7768. end;
  7769. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7770. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7771. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7772. type
  7773. TMatrixItem = record
  7774. X, Y: Integer;
  7775. W: Single;
  7776. end;
  7777. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7778. TglBitmapToNormalMapRec = Record
  7779. Scale: Single;
  7780. Heights: array of Single;
  7781. MatrixU : array of TMatrixItem;
  7782. MatrixV : array of TMatrixItem;
  7783. end;
  7784. const
  7785. ONE_OVER_255 = 1 / 255;
  7786. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7787. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7788. var
  7789. Val: Single;
  7790. begin
  7791. with FuncRec do begin
  7792. Val :=
  7793. Source.Data.r * LUMINANCE_WEIGHT_R +
  7794. Source.Data.g * LUMINANCE_WEIGHT_G +
  7795. Source.Data.b * LUMINANCE_WEIGHT_B;
  7796. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7797. end;
  7798. end;
  7799. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7800. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7801. begin
  7802. with FuncRec do
  7803. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7804. end;
  7805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7806. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7807. type
  7808. TVec = Array[0..2] of Single;
  7809. var
  7810. Idx: Integer;
  7811. du, dv: Double;
  7812. Len: Single;
  7813. Vec: TVec;
  7814. function GetHeight(X, Y: Integer): Single;
  7815. begin
  7816. with FuncRec do begin
  7817. X := Max(0, Min(Size.X -1, X));
  7818. Y := Max(0, Min(Size.Y -1, Y));
  7819. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7820. end;
  7821. end;
  7822. begin
  7823. with FuncRec do begin
  7824. with PglBitmapToNormalMapRec(Args)^ do begin
  7825. du := 0;
  7826. for Idx := Low(MatrixU) to High(MatrixU) do
  7827. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7828. dv := 0;
  7829. for Idx := Low(MatrixU) to High(MatrixU) do
  7830. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7831. Vec[0] := -du * Scale;
  7832. Vec[1] := -dv * Scale;
  7833. Vec[2] := 1;
  7834. end;
  7835. // Normalize
  7836. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7837. if Len <> 0 then begin
  7838. Vec[0] := Vec[0] * Len;
  7839. Vec[1] := Vec[1] * Len;
  7840. Vec[2] := Vec[2] * Len;
  7841. end;
  7842. // Farbe zuweisem
  7843. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7844. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7845. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7846. end;
  7847. end;
  7848. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7849. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7850. var
  7851. Rec: TglBitmapToNormalMapRec;
  7852. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7853. begin
  7854. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7855. Matrix[Index].X := X;
  7856. Matrix[Index].Y := Y;
  7857. Matrix[Index].W := W;
  7858. end;
  7859. end;
  7860. begin
  7861. if TFormatDescriptor.Get(Format).IsCompressed then
  7862. raise EglBitmapUnsupportedFormat.Create(Format);
  7863. if aScale > 100 then
  7864. Rec.Scale := 100
  7865. else if aScale < -100 then
  7866. Rec.Scale := -100
  7867. else
  7868. Rec.Scale := aScale;
  7869. SetLength(Rec.Heights, Width * Height);
  7870. try
  7871. case aFunc of
  7872. nm4Samples: begin
  7873. SetLength(Rec.MatrixU, 2);
  7874. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7875. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7876. SetLength(Rec.MatrixV, 2);
  7877. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7878. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7879. end;
  7880. nmSobel: begin
  7881. SetLength(Rec.MatrixU, 6);
  7882. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7883. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7884. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7885. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7886. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7887. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7888. SetLength(Rec.MatrixV, 6);
  7889. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7890. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7891. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7892. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7893. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7894. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7895. end;
  7896. nm3x3: begin
  7897. SetLength(Rec.MatrixU, 6);
  7898. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7899. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7900. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7901. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7902. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7903. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7904. SetLength(Rec.MatrixV, 6);
  7905. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7906. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7907. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7908. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7909. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7910. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7911. end;
  7912. nm5x5: begin
  7913. SetLength(Rec.MatrixU, 20);
  7914. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7915. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7916. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7917. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7918. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7919. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7920. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7921. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7922. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7923. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7924. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7925. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7926. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7927. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7928. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7929. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7930. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7931. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7932. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7933. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7934. SetLength(Rec.MatrixV, 20);
  7935. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7936. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7937. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7938. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7939. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7940. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7941. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7942. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7943. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7944. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7945. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7946. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7947. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7948. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7949. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7950. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7951. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7952. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7953. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7954. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7955. end;
  7956. end;
  7957. // Daten Sammeln
  7958. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7959. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7960. else
  7961. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7962. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7963. finally
  7964. SetLength(Rec.Heights, 0);
  7965. end;
  7966. end;
  7967. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7969. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7970. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7971. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7972. begin
  7973. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7974. end;
  7975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7976. procedure TglBitmapCubeMap.AfterConstruction;
  7977. begin
  7978. inherited;
  7979. {$IFNDEF OPENGL_ES}
  7980. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7981. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7982. {$ELSE}
  7983. if not (GL_VERSION_2_0) then
  7984. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7985. {$ENDIF}
  7986. SetWrap;
  7987. Target := GL_TEXTURE_CUBE_MAP;
  7988. {$IFNDEF OPENGL_ES}
  7989. fGenMode := GL_REFLECTION_MAP;
  7990. {$ENDIF}
  7991. end;
  7992. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7993. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7994. var
  7995. {$IFNDEF OPENGL_ES}
  7996. BuildWithGlu: Boolean;
  7997. {$ENDIF}
  7998. TexSize: Integer;
  7999. begin
  8000. if (aTestTextureSize) then begin
  8001. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  8002. if (Height > TexSize) or (Width > TexSize) then
  8003. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  8004. {$IF NOT DEFINED(OPENGL_ES)}
  8005. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  8006. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  8007. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  8008. if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) and not GL_OES_texture_npot then
  8009. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  8010. {$ELSE}
  8011. if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) then
  8012. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  8013. {$IFEND}
  8014. end;
  8015. if (ID = 0) then
  8016. CreateID;
  8017. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  8018. UploadData(aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  8019. end;
  8020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8021. procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
  8022. begin
  8023. inherited Bind (aEnableTextureUnit);
  8024. {$IFNDEF OPENGL_ES}
  8025. if aEnableTexCoordsGen then begin
  8026. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  8027. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  8028. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  8029. glEnable(GL_TEXTURE_GEN_S);
  8030. glEnable(GL_TEXTURE_GEN_T);
  8031. glEnable(GL_TEXTURE_GEN_R);
  8032. end;
  8033. {$ENDIF}
  8034. end;
  8035. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8036. procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
  8037. begin
  8038. inherited Unbind(aDisableTextureUnit);
  8039. {$IFNDEF OPENGL_ES}
  8040. if aDisableTexCoordsGen then begin
  8041. glDisable(GL_TEXTURE_GEN_S);
  8042. glDisable(GL_TEXTURE_GEN_T);
  8043. glDisable(GL_TEXTURE_GEN_R);
  8044. end;
  8045. {$ENDIF}
  8046. end;
  8047. {$IFEND}
  8048. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  8049. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8050. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8051. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8052. type
  8053. TVec = Array[0..2] of Single;
  8054. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8055. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  8056. TglBitmapNormalMapRec = record
  8057. HalfSize : Integer;
  8058. Func: TglBitmapNormalMapGetVectorFunc;
  8059. end;
  8060. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8061. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8062. begin
  8063. aVec[0] := aHalfSize;
  8064. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  8065. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  8066. end;
  8067. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8068. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8069. begin
  8070. aVec[0] := - aHalfSize;
  8071. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  8072. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  8073. end;
  8074. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8075. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8076. begin
  8077. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  8078. aVec[1] := aHalfSize;
  8079. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  8080. end;
  8081. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8082. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8083. begin
  8084. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  8085. aVec[1] := - aHalfSize;
  8086. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  8087. end;
  8088. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8089. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8090. begin
  8091. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  8092. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  8093. aVec[2] := aHalfSize;
  8094. end;
  8095. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8096. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  8097. begin
  8098. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  8099. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  8100. aVec[2] := - aHalfSize;
  8101. end;
  8102. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8103. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  8104. var
  8105. i: Integer;
  8106. Vec: TVec;
  8107. Len: Single;
  8108. begin
  8109. with FuncRec do begin
  8110. with PglBitmapNormalMapRec(Args)^ do begin
  8111. Func(Vec, Position, HalfSize);
  8112. // Normalize
  8113. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  8114. if Len <> 0 then begin
  8115. Vec[0] := Vec[0] * Len;
  8116. Vec[1] := Vec[1] * Len;
  8117. Vec[2] := Vec[2] * Len;
  8118. end;
  8119. // Scale Vector and AddVectro
  8120. Vec[0] := Vec[0] * 0.5 + 0.5;
  8121. Vec[1] := Vec[1] * 0.5 + 0.5;
  8122. Vec[2] := Vec[2] * 0.5 + 0.5;
  8123. end;
  8124. // Set Color
  8125. for i := 0 to 2 do
  8126. Dest.Data.arr[i] := Round(Vec[i] * 255);
  8127. end;
  8128. end;
  8129. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8130. procedure TglBitmapNormalMap.AfterConstruction;
  8131. begin
  8132. inherited;
  8133. {$IFNDEF OPENGL_ES}
  8134. fGenMode := GL_NORMAL_MAP;
  8135. {$ENDIF}
  8136. end;
  8137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8138. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  8139. var
  8140. Rec: TglBitmapNormalMapRec;
  8141. SizeRec: TglBitmapPixelPosition;
  8142. begin
  8143. Rec.HalfSize := aSize div 2;
  8144. FreeDataAfterGenTexture := false;
  8145. SizeRec.Fields := [ffX, ffY];
  8146. SizeRec.X := aSize;
  8147. SizeRec.Y := aSize;
  8148. // Positive X
  8149. Rec.Func := glBitmapNormalMapPosX;
  8150. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8151. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  8152. // Negative X
  8153. Rec.Func := glBitmapNormalMapNegX;
  8154. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8155. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  8156. // Positive Y
  8157. Rec.Func := glBitmapNormalMapPosY;
  8158. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8159. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  8160. // Negative Y
  8161. Rec.Func := glBitmapNormalMapNegY;
  8162. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8163. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  8164. // Positive Z
  8165. Rec.Func := glBitmapNormalMapPosZ;
  8166. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8167. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  8168. // Negative Z
  8169. Rec.Func := glBitmapNormalMapNegZ;
  8170. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8171. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  8172. end;
  8173. {$IFEND}
  8174. initialization
  8175. glBitmapSetDefaultFormat (tfEmpty);
  8176. glBitmapSetDefaultMipmap (mmMipmap);
  8177. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  8178. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  8179. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  8180. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  8181. {$IFEND}
  8182. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  8183. glBitmapSetDefaultDeleteTextureOnFree (true);
  8184. TFormatDescriptor.Init;
  8185. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  8186. OpenGLInitialized := false;
  8187. InitOpenGLCS := TCriticalSection.Create;
  8188. {$ENDIF}
  8189. finalization
  8190. TFormatDescriptor.Finalize;
  8191. {$IFDEF GLB_NATIVE_OGL}
  8192. if Assigned(GL_LibHandle) then
  8193. glbFreeLibrary(GL_LibHandle);
  8194. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  8195. if Assigned(GLU_LibHandle) then
  8196. glbFreeLibrary(GLU_LibHandle);
  8197. FreeAndNil(InitOpenGLCS);
  8198. {$ENDIF}
  8199. {$ENDIF}
  8200. end.