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.

8801 lines
314 KiB

  1. {***********************************************************
  2. glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  3. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  4. modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
  5. ------------------------------------------------------------
  6. The contents of this file are used with permission, subject to
  7. the Mozilla Public License Version 1.1 (the "License"); you may
  8. not use this file except in compliance with the License. You may
  9. obtain a copy of the License at
  10. http://www.mozilla.org/MPL/MPL-1.1.html
  11. ------------------------------------------------------------
  12. Version 3.0.1
  13. ------------------------------------------------------------
  14. History
  15. 20-11-2013
  16. - refactoring of the complete library
  17. 21-03-2010
  18. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  19. then it's your problem if that isn't true. This prevents the unit for incompatibility
  20. with newer versions of Delphi.
  21. - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  22. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  23. 10-08-2008
  24. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  25. - Additional Datapointer for functioninterface now has the name CustomData
  26. 24-07-2008
  27. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  28. - If you load an texture from an file the property Filename will be set to the name of the file
  29. - Three new properties to attach custom data to the Texture objects
  30. - CustomName (free for use string)
  31. - CustomNameW (free for use widestring)
  32. - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  33. 27-05-2008
  34. - RLE TGAs loaded much faster
  35. 26-05-2008
  36. - fixed some problem with reading RLE TGAs.
  37. 21-05-2008
  38. - function clone now only copys data if it's assigned and now it also copies the ID
  39. - it seems that lazarus dont like comments in comments.
  40. 01-05-2008
  41. - It's possible to set the id of the texture
  42. - define GLB_NO_NATIVE_GL deactivated by default
  43. 27-04-2008
  44. - Now supports the following libraries
  45. - SDL and SDL_image
  46. - libPNG
  47. - libJPEG
  48. - Linux compatibillity via free pascal compatibility (delphi sources optional)
  49. - BMPs now loaded manuel
  50. - Large restructuring
  51. - Property DataPtr now has the name Data
  52. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  53. - Unused Depth removed
  54. - Function FreeData to freeing image data added
  55. 24-10-2007
  56. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  57. 15-11-2006
  58. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  59. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  60. - Function ReadOpenGLExtension is now only intern
  61. 29-06-2006
  62. - pngimage now disabled by default like all other versions.
  63. 26-06-2006
  64. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  65. 22-06-2006
  66. - Fixed some Problem with Delphi 5
  67. - Now uses the newest version of pngimage. Makes saving pngs much easier.
  68. 22-03-2006
  69. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  70. 09-03-2006
  71. - Internal Format ifDepth8 added
  72. - function GrabScreen now supports all uncompressed formats
  73. 31-01-2006
  74. - AddAlphaFromglBitmap implemented
  75. 29-12-2005
  76. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  77. 28-12-2005
  78. - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  79. property Width, Height, Depth are still existing and new property Dimension are avail
  80. 11-12-2005
  81. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  82. 19-10-2005
  83. - Added function GrabScreen to class TglBitmap2D
  84. 18-10-2005
  85. - Added support to Save images
  86. - Added function Clone to Clone Instance
  87. 11-10-2005
  88. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  89. Usefull for Future
  90. - Several speed optimizations
  91. 09-10-2005
  92. - Internal structure change. Loading of TGA, PNG and DDS improved.
  93. Data, format and size will now set directly with SetDataPtr.
  94. - AddFunc now works with all Types of Images and Formats
  95. - Some Funtions moved to Baseclass TglBitmap
  96. 06-10-2005
  97. - Added Support to decompress DXT3 and DXT5 compressed Images.
  98. - Added Mapping to convert data from one format into an other.
  99. 05-10-2005
  100. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  101. supported Input format (supported by GetPixel) into any uncompresed Format
  102. - Added Support to decompress DXT1 compressed Images.
  103. - SwapColors replaced by ConvertTo
  104. 04-10-2005
  105. - Added Support for compressed DDSs
  106. - Added new internal formats (DXT1, DXT3, DXT5)
  107. 29-09-2005
  108. - Parameter Components renamed to InternalFormat
  109. 23-09-2005
  110. - Some AllocMem replaced with GetMem (little speed change)
  111. - better exception handling. Better protection from memory leaks.
  112. 22-09-2005
  113. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
  114. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
  115. 07-09-2005
  116. - Added support for Grayscale textures
  117. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
  118. 10-07-2005
  119. - Added support for GL_VERSION_2_0
  120. - Added support for GL_EXT_texture_filter_anisotropic
  121. 04-07-2005
  122. - Function FillWithColor fills the Image with one Color
  123. - Function LoadNormalMap added
  124. 30-06-2005
  125. - ToNormalMap allows to Create an NormalMap from the Alphachannel
  126. - ToNormalMap now supports Sobel (nmSobel) function.
  127. 29-06-2005
  128. - support for RLE Compressed RGB TGAs added
  129. 28-06-2005
  130. - Class TglBitmapNormalMap added to support Normalmap generation
  131. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
  132. 3 Filters are supported. (4 Samples, 3x3 and 5x5)
  133. 16-06-2005
  134. - Method LoadCubeMapClass removed
  135. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
  136. - virtual abstract method GenTexture in class TglBitmap now is protected
  137. 12-06-2005
  138. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
  139. 10-06-2005
  140. - little enhancement for IsPowerOfTwo
  141. - TglBitmap1D.GenTexture now tests NPOT Textures
  142. 06-06-2005
  143. - some little name changes. All properties or function with Texture in name are
  144. now without texture in name. We have allways texture so we dosn't name it.
  145. 03-06-2005
  146. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
  147. TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
  148. 02-06-2005
  149. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
  150. 25-04-2005
  151. - Function Unbind added
  152. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
  153. 21-04-2005
  154. - class TglBitmapCubeMap added (allows to Create Cubemaps)
  155. 29-03-2005
  156. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
  157. To Enable png's use the define pngimage
  158. 22-03-2005
  159. - New Functioninterface added
  160. - Function GetPixel added
  161. 27-11-2004
  162. - Property BuildMipMaps renamed to MipMap
  163. 21-11-2004
  164. - property Name removed.
  165. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
  166. 22-05-2004
  167. - property name added. Only used in glForms!
  168. 26-11-2003
  169. - property FreeDataAfterGenTexture is now available as default (default = true)
  170. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
  171. - function MoveMemory replaced with function Move (little speed change)
  172. - several calculations stored in variables (little speed change)
  173. 29-09-2003
  174. - property BuildMipsMaps added (default = true)
  175. if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
  176. - property FreeDataAfterGenTexture added (default = true)
  177. if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
  178. - parameter DisableOtherTextureUnits of Bind removed
  179. - parameter FreeDataAfterGeneration of GenTextures removed
  180. 12-09-2003
  181. - TglBitmap dosn't delete data if class was destroyed (fixed)
  182. 09-09-2003
  183. - Bind now enables TextureUnits (by params)
  184. - GenTextures can leave data (by param)
  185. - LoadTextures now optimal
  186. 03-09-2003
  187. - Performance optimization in AddFunc
  188. - procedure Bind moved to subclasses
  189. - Added new Class TglBitmap1D to support real OpenGL 1D Textures
  190. 19-08-2003
  191. - Texturefilter and texturewrap now also as defaults
  192. Minfilter = GL_LINEAR_MIPMAP_LINEAR
  193. Magfilter = GL_LINEAR
  194. Wrap(str) = GL_CLAMP_TO_EDGE
  195. - Added new format tfCompressed to create a compressed texture.
  196. - propertys IsCompressed, TextureSize and IsResident added
  197. IsCompressed and TextureSize only contains data from level 0
  198. 18-08-2003
  199. - Added function AddFunc to add PerPixelEffects to Image
  200. - LoadFromFunc now based on AddFunc
  201. - Invert now based on AddFunc
  202. - SwapColors now based on AddFunc
  203. 16-08-2003
  204. - Added function FlipHorz
  205. 15-08-2003
  206. - Added function LaodFromFunc to create images with function
  207. - Added function FlipVert
  208. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
  209. 29-07-2003
  210. - Added Alphafunctions to calculate alpha per function
  211. - Added Alpha from ColorKey using alphafunctions
  212. 28-07-2003
  213. - First full functionally Version of glBitmap
  214. - Support for 24Bit and 32Bit TGA Pictures added
  215. 25-07-2003
  216. - begin of programming
  217. ***********************************************************}
  218. unit glBitmap;
  219. // Please uncomment the defines below to configure the glBitmap to your preferences.
  220. // If you have configured the unit you can uncomment the warning above.
  221. {$MESSAGE error 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  223. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  225. // activate to enable build-in OpenGL support with statically linked methods
  226. // use dglOpenGL.pas if not enabled
  227. {.$DEFINE GLB_NATIVE_OGL_STATIC}
  228. // activate to enable build-in OpenGL support with dynamically linked methods
  229. // use dglOpenGL.pas if not enabled
  230. {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
  231. // activate to enable the support for SDL_surfaces
  232. {.$DEFINE GLB_SDL}
  233. // activate to enable the support for Delphi (including support for Delphi's (not Lazarus') TBitmap)
  234. {.$DEFINE GLB_DELPHI}
  235. // activate to enable the support for TLazIntfImage from Lazarus
  236. {.$DEFINE GLB_LAZARUS}
  237. // activate to enable the support of SDL_image to load files. (READ ONLY)
  238. // If you enable SDL_image all other libraries will be ignored!
  239. {.$DEFINE GLB_SDL_IMAGE}
  240. // activate to enable Lazarus TPortableNetworkGraphic support
  241. // if you enable this pngImage and libPNG will be ignored
  242. {.$DEFINE GLB_LAZ_PNG}
  243. // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
  244. // if you enable pngimage the libPNG will be ignored
  245. {.$DEFINE GLB_PNGIMAGE}
  246. // activate to use the libPNG -> http://www.libpng.org/
  247. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
  248. {.$DEFINE GLB_LIB_PNG}
  249. // activate to enable Lazarus TJPEGImage support
  250. // if you enable this delphi jpegs and libJPEG will be ignored
  251. {.$DEFINE GLB_LAZ_JPEG}
  252. // if you enable delphi jpegs the libJPEG will be ignored
  253. {.$DEFINE GLB_DELPHI_JPEG}
  254. // activate to use the libJPEG -> http://www.ijg.org/
  255. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
  256. {.$DEFINE GLB_LIB_JPEG}
  257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  258. // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  259. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  260. // Delphi Versions
  261. {$IFDEF fpc}
  262. {$MODE Delphi}
  263. {$IFDEF CPUI386}
  264. {$DEFINE CPU386}
  265. {$ASMMODE INTEL}
  266. {$ENDIF}
  267. {$IFNDEF WINDOWS}
  268. {$linklib c}
  269. {$ENDIF}
  270. {$ENDIF}
  271. // Operation System
  272. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  273. {$DEFINE GLB_WIN}
  274. {$ELSEIF DEFINED(LINUX)}
  275. {$DEFINE GLB_LINUX}
  276. {$IFEND}
  277. // native OpenGL Support
  278. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  279. {$DEFINE GLB_NATIVE_OGL}
  280. {$IFEND}
  281. // checking define combinations
  282. //SDL Image
  283. {$IFDEF GLB_SDL_IMAGE}
  284. {$IFNDEF GLB_SDL}
  285. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  286. {$DEFINE GLB_SDL}
  287. {$ENDIF}
  288. {$IFDEF GLB_LAZ_PNG}
  289. {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  290. {$undef GLB_LAZ_PNG}
  291. {$ENDIF}
  292. {$IFDEF GLB_PNGIMAGE}
  293. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  294. {$undef GLB_PNGIMAGE}
  295. {$ENDIF}
  296. {$IFDEF GLB_LAZ_JPEG}
  297. {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  298. {$undef GLB_LAZ_JPEG}
  299. {$ENDIF}
  300. {$IFDEF GLB_DELPHI_JPEG}
  301. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  302. {$undef GLB_DELPHI_JPEG}
  303. {$ENDIF}
  304. {$IFDEF GLB_LIB_PNG}
  305. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  306. {$undef GLB_LIB_PNG}
  307. {$ENDIF}
  308. {$IFDEF GLB_LIB_JPEG}
  309. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  310. {$undef GLB_LIB_JPEG}
  311. {$ENDIF}
  312. {$DEFINE GLB_SUPPORT_PNG_READ}
  313. {$DEFINE GLB_SUPPORT_JPEG_READ}
  314. {$ENDIF}
  315. // Lazarus TPortableNetworkGraphic
  316. {$IFDEF GLB_LAZ_PNG}
  317. {$IFNDEF GLB_LAZARUS}
  318. {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
  319. {$DEFINE GLB_LAZARUS}
  320. {$ENDIF}
  321. {$IFDEF GLB_PNGIMAGE}
  322. {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  323. {$undef GLB_PNGIMAGE}
  324. {$ENDIF}
  325. {$IFDEF GLB_LIB_PNG}
  326. {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  327. {$undef GLB_LIB_PNG}
  328. {$ENDIF}
  329. {$DEFINE GLB_SUPPORT_PNG_READ}
  330. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  331. {$ENDIF}
  332. // PNG Image
  333. {$IFDEF GLB_PNGIMAGE}
  334. {$IFDEF GLB_LIB_PNG}
  335. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  336. {$undef GLB_LIB_PNG}
  337. {$ENDIF}
  338. {$DEFINE GLB_SUPPORT_PNG_READ}
  339. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  340. {$ENDIF}
  341. // libPNG
  342. {$IFDEF GLB_LIB_PNG}
  343. {$DEFINE GLB_SUPPORT_PNG_READ}
  344. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  345. {$ENDIF}
  346. // Lazarus TJPEGImage
  347. {$IFDEF GLB_LAZ_JPEG}
  348. {$IFNDEF GLB_LAZARUS}
  349. {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
  350. {$DEFINE GLB_LAZARUS}
  351. {$ENDIF}
  352. {$IFDEF GLB_DELPHI_JPEG}
  353. {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
  354. {$undef GLB_DELPHI_JPEG}
  355. {$ENDIF}
  356. {$IFDEF GLB_LIB_JPEG}
  357. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
  358. {$undef GLB_LIB_JPEG}
  359. {$ENDIF}
  360. {$DEFINE GLB_SUPPORT_JPEG_READ}
  361. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  362. {$ENDIF}
  363. // JPEG Image
  364. {$IFDEF GLB_DELPHI_JPEG}
  365. {$IFDEF GLB_LIB_JPEG}
  366. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  367. {$undef GLB_LIB_JPEG}
  368. {$ENDIF}
  369. {$DEFINE GLB_SUPPORT_JPEG_READ}
  370. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  371. {$ENDIF}
  372. // libJPEG
  373. {$IFDEF GLB_LIB_JPEG}
  374. {$DEFINE GLB_SUPPORT_JPEG_READ}
  375. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  376. {$ENDIF}
  377. // native OpenGL
  378. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  379. {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
  380. {$IFEND}
  381. // general options
  382. {$EXTENDEDSYNTAX ON}
  383. {$LONGSTRINGS ON}
  384. {$ALIGN ON}
  385. {$IFNDEF FPC}
  386. {$OPTIMIZATION ON}
  387. {$ENDIF}
  388. interface
  389. uses
  390. {$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
  391. {$IF DEFINED(GLB_WIN) AND
  392. (DEFINED(GLB_NATIVE_OGL) OR
  393. DEFINED(GLB_DELPHI))} windows, {$IFEND}
  394. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  395. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  396. {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$ENDIF}
  397. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  398. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  399. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  400. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  401. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  402. Classes, SysUtils;
  403. {$IFDEF GLB_NATIVE_OGL}
  404. const
  405. GL_TRUE = 1;
  406. GL_FALSE = 0;
  407. GL_ZERO = 0;
  408. GL_ONE = 1;
  409. GL_VERSION = $1F02;
  410. GL_EXTENSIONS = $1F03;
  411. GL_TEXTURE_1D = $0DE0;
  412. GL_TEXTURE_2D = $0DE1;
  413. GL_TEXTURE_RECTANGLE = $84F5;
  414. GL_NORMAL_MAP = $8511;
  415. GL_TEXTURE_CUBE_MAP = $8513;
  416. GL_REFLECTION_MAP = $8512;
  417. GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
  418. GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
  419. GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
  420. GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
  421. GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
  422. GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
  423. GL_TEXTURE_WIDTH = $1000;
  424. GL_TEXTURE_HEIGHT = $1001;
  425. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  426. GL_TEXTURE_SWIZZLE_RGBA = $8E46;
  427. GL_S = $2000;
  428. GL_T = $2001;
  429. GL_R = $2002;
  430. GL_Q = $2003;
  431. GL_TEXTURE_GEN_S = $0C60;
  432. GL_TEXTURE_GEN_T = $0C61;
  433. GL_TEXTURE_GEN_R = $0C62;
  434. GL_TEXTURE_GEN_Q = $0C63;
  435. GL_RED = $1903;
  436. GL_GREEN = $1904;
  437. GL_BLUE = $1905;
  438. GL_ALPHA = $1906;
  439. GL_ALPHA4 = $803B;
  440. GL_ALPHA8 = $803C;
  441. GL_ALPHA12 = $803D;
  442. GL_ALPHA16 = $803E;
  443. GL_LUMINANCE = $1909;
  444. GL_LUMINANCE4 = $803F;
  445. GL_LUMINANCE8 = $8040;
  446. GL_LUMINANCE12 = $8041;
  447. GL_LUMINANCE16 = $8042;
  448. GL_LUMINANCE_ALPHA = $190A;
  449. GL_LUMINANCE4_ALPHA4 = $8043;
  450. GL_LUMINANCE6_ALPHA2 = $8044;
  451. GL_LUMINANCE8_ALPHA8 = $8045;
  452. GL_LUMINANCE12_ALPHA4 = $8046;
  453. GL_LUMINANCE12_ALPHA12 = $8047;
  454. GL_LUMINANCE16_ALPHA16 = $8048;
  455. GL_RGB = $1907;
  456. GL_BGR = $80E0;
  457. GL_R3_G3_B2 = $2A10;
  458. GL_RGB4 = $804F;
  459. GL_RGB5 = $8050;
  460. GL_RGB565 = $8D62;
  461. GL_RGB8 = $8051;
  462. GL_RGB10 = $8052;
  463. GL_RGB12 = $8053;
  464. GL_RGB16 = $8054;
  465. GL_RGBA = $1908;
  466. GL_BGRA = $80E1;
  467. GL_RGBA2 = $8055;
  468. GL_RGBA4 = $8056;
  469. GL_RGB5_A1 = $8057;
  470. GL_RGBA8 = $8058;
  471. GL_RGB10_A2 = $8059;
  472. GL_RGBA12 = $805A;
  473. GL_RGBA16 = $805B;
  474. GL_DEPTH_COMPONENT = $1902;
  475. GL_DEPTH_COMPONENT16 = $81A5;
  476. GL_DEPTH_COMPONENT24 = $81A6;
  477. GL_DEPTH_COMPONENT32 = $81A7;
  478. GL_COMPRESSED_RGB = $84ED;
  479. GL_COMPRESSED_RGBA = $84EE;
  480. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  481. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  482. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  483. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  484. GL_UNSIGNED_BYTE = $1401;
  485. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  486. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  487. GL_UNSIGNED_SHORT = $1403;
  488. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  489. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  490. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  491. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  492. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  493. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  494. GL_UNSIGNED_INT = $1405;
  495. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  496. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  497. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  498. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  499. { Texture Filter }
  500. GL_TEXTURE_MAG_FILTER = $2800;
  501. GL_TEXTURE_MIN_FILTER = $2801;
  502. GL_NEAREST = $2600;
  503. GL_NEAREST_MIPMAP_NEAREST = $2700;
  504. GL_NEAREST_MIPMAP_LINEAR = $2702;
  505. GL_LINEAR = $2601;
  506. GL_LINEAR_MIPMAP_NEAREST = $2701;
  507. GL_LINEAR_MIPMAP_LINEAR = $2703;
  508. { Texture Wrap }
  509. GL_TEXTURE_WRAP_S = $2802;
  510. GL_TEXTURE_WRAP_T = $2803;
  511. GL_TEXTURE_WRAP_R = $8072;
  512. GL_CLAMP = $2900;
  513. GL_REPEAT = $2901;
  514. GL_CLAMP_TO_EDGE = $812F;
  515. GL_CLAMP_TO_BORDER = $812D;
  516. GL_MIRRORED_REPEAT = $8370;
  517. { Other }
  518. GL_GENERATE_MIPMAP = $8191;
  519. GL_TEXTURE_BORDER_COLOR = $1004;
  520. GL_MAX_TEXTURE_SIZE = $0D33;
  521. GL_PACK_ALIGNMENT = $0D05;
  522. GL_UNPACK_ALIGNMENT = $0CF5;
  523. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  524. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  525. GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
  526. GL_TEXTURE_GEN_MODE = $2500;
  527. {$IF DEFINED(GLB_WIN)}
  528. libglu = 'glu32.dll';
  529. libopengl = 'opengl32.dll';
  530. {$ELSEIF DEFINED(GLB_LINUX)}
  531. libglu = 'libGLU.so.1';
  532. libopengl = 'libGL.so.1';
  533. {$IFEND}
  534. type
  535. GLboolean = BYTEBOOL;
  536. GLint = Integer;
  537. GLsizei = Integer;
  538. GLuint = Cardinal;
  539. GLfloat = Single;
  540. GLenum = Cardinal;
  541. PGLvoid = Pointer;
  542. PGLboolean = ^GLboolean;
  543. PGLint = ^GLint;
  544. PGLuint = ^GLuint;
  545. PGLfloat = ^GLfloat;
  546. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  547. 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}
  548. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  549. {$IF DEFINED(GLB_WIN)}
  550. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  551. {$ELSEIF DEFINED(GLB_LINUX)}
  552. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  553. TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
  554. {$IFEND}
  555. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  556. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  557. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  558. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  559. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  560. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  561. TglTexParameteriv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  562. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  563. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  564. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  565. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  566. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  567. TglTexGeni = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  568. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  569. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  570. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  571. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  572. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  573. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  574. 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}
  575. 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}
  576. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  577. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  578. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  579. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  580. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  581. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  582. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  583. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  584. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  585. procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  586. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  587. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  588. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  589. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  590. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  591. procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  592. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  593. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  594. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  595. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  596. 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;
  597. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  598. 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;
  599. 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;
  600. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  601. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  602. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  603. {$IFEND}
  604. var
  605. GL_VERSION_1_2,
  606. GL_VERSION_1_3,
  607. GL_VERSION_1_4,
  608. GL_VERSION_2_0,
  609. GL_VERSION_3_3,
  610. GL_SGIS_generate_mipmap,
  611. GL_ARB_texture_border_clamp,
  612. GL_ARB_texture_mirrored_repeat,
  613. GL_ARB_texture_rectangle,
  614. GL_ARB_texture_non_power_of_two,
  615. GL_ARB_texture_swizzle,
  616. GL_ARB_texture_cube_map,
  617. GL_IBM_texture_mirrored_repeat,
  618. GL_NV_texture_rectangle,
  619. GL_EXT_texture_edge_clamp,
  620. GL_EXT_texture_rectangle,
  621. GL_EXT_texture_swizzle,
  622. GL_EXT_texture_cube_map,
  623. GL_EXT_texture_filter_anisotropic: Boolean;
  624. glCompressedTexImage1D: TglCompressedTexImage1D;
  625. glCompressedTexImage2D: TglCompressedTexImage2D;
  626. glGetCompressedTexImage: TglGetCompressedTexImage;
  627. {$IF DEFINED(GLB_WIN)}
  628. wglGetProcAddress: TwglGetProcAddress;
  629. {$ELSEIF DEFINED(GLB_LINUX)}
  630. glXGetProcAddress: TglXGetProcAddress;
  631. glXGetProcAddressARB: TglXGetProcAddress;
  632. {$IFEND}
  633. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  634. glEnable: TglEnable;
  635. glDisable: TglDisable;
  636. glGetString: TglGetString;
  637. glGetIntegerv: TglGetIntegerv;
  638. glTexParameteri: TglTexParameteri;
  639. glTexParameteriv: TglTexParameteriv;
  640. glTexParameterfv: TglTexParameterfv;
  641. glGetTexParameteriv: TglGetTexParameteriv;
  642. glGetTexParameterfv: TglGetTexParameterfv;
  643. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  644. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  645. glTexGeni: TglTexGeni;
  646. glGenTextures: TglGenTextures;
  647. glBindTexture: TglBindTexture;
  648. glDeleteTextures: TglDeleteTextures;
  649. glAreTexturesResident: TglAreTexturesResident;
  650. glReadPixels: TglReadPixels;
  651. glPixelStorei: TglPixelStorei;
  652. glTexImage1D: TglTexImage1D;
  653. glTexImage2D: TglTexImage2D;
  654. glGetTexImage: TglGetTexImage;
  655. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  656. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  657. {$ENDIF}
  658. {$ENDIF}
  659. type
  660. ////////////////////////////////////////////////////////////////////////////////////////////////////
  661. // the name of formats is composed of the following constituents:
  662. // - multiple chanals:
  663. // - channel (e.g. R, G, B, A or Alpha, Luminance or X (reserved)
  664. // - width of the chanel in bit (4, 8, 16, ...)
  665. // - data type (e.g. ub, us, ui)
  666. // - number of data types
  667. TglBitmapFormat = (
  668. tfEmpty = 0, //must be smallest value!
  669. tfAlpha4ub1, // 1 x unsigned byte
  670. tfAlpha8ub1, // 1 x unsigned byte
  671. tfAlpha16us1, // 1 x unsigned short
  672. tfLuminance4ub1, // 1 x unsigned byte
  673. tfLuminance8ub1, // 1 x unsigned byte
  674. tfLuminance16us1, // 1 x unsigned short
  675. tfLuminance4Alpha4ub2, // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  676. tfLuminance6Alpha2ub2, // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  677. tfLuminance8Alpha8ub2, // 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  678. tfLuminance12Alpha4us2, // 1 x unsigned short (lum), 1 x unsigned short (alpha)
  679. tfLuminance16Alpha16us2, // 1 x unsigned short (lum), 1 x unsigned short (alpha)
  680. tfR3G3B2ub1, // 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
  681. tfRGBX4us1, // 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
  682. tfXRGB4us1, // 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
  683. tfR5G6B5us1, // 1 x unsigned short (5bit red, 6bit green, 5bit blue)
  684. tfRGB5X1us1, // 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
  685. tfX1RGB5us1, // 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
  686. tfRGB8ub3, // 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
  687. tfRGBX8ui1, // 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
  688. tfXRGB8ui1, // 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
  689. tfRGB10X2ui1, // 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
  690. tfX2RGB10ui1, // 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
  691. tfRGB16us3, // 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
  692. tfRGBA4us1, // 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
  693. tfARGB4us1, // 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
  694. tfRGB5A1us1, // 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
  695. tfA1RGB5us1, // 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
  696. tfRGBA8ui1, // 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
  697. tfARGB8ui1, // 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
  698. tfRGBA8ub4, // 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
  699. tfRGB10A2ui1, // 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
  700. tfA2RGB10ui1, // 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
  701. tfRGBA16us4, // 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
  702. tfBGRX4us1, // 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
  703. tfXBGR4us1, // 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
  704. tfB5G6R5us1, // 1 x unsigned short (5bit blue, 6bit green, 5bit red)
  705. tfBGR5X1us1, // 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
  706. tfX1BGR5us1, // 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
  707. tfBGR8ub3, // 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
  708. tfBGRX8ui1, // 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
  709. tfXBGR8ui1, // 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
  710. tfBGR10X2ui1, // 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
  711. tfX2BGR10ui1, // 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
  712. tfBGR16us3, // 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
  713. tfBGRA4us1, // 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
  714. tfABGR4us1, // 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
  715. tfBGR5A1us1, // 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
  716. tfA1BGR5us1, // 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
  717. tfBGRA8ui1, // 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
  718. tfABGR8ui1, // 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
  719. tfBGRA8ub4, // 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
  720. tfBGR10A2ui1, // 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
  721. tfA2BGR10ui1, // 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
  722. tfBGRA16us4, // 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
  723. tfDepth16us1, // 1 x unsigned short (depth)
  724. tfDepth24ui1, // 1 x unsigned int (depth)
  725. tfDepth32ui1, // 1 x unsigned int (depth)
  726. tfS3tcDtx1RGBA,
  727. tfS3tcDtx3RGBA,
  728. tfS3tcDtx5RGBA
  729. );
  730. TglBitmapFileType = (
  731. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  732. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  733. ftDDS,
  734. ftTGA,
  735. ftBMP);
  736. TglBitmapFileTypes = set of TglBitmapFileType;
  737. TglBitmapMipMap = (
  738. mmNone,
  739. mmMipmap,
  740. mmMipmapGlu);
  741. TglBitmapNormalMapFunc = (
  742. nm4Samples,
  743. nmSobel,
  744. nm3x3,
  745. nm5x5);
  746. ////////////////////////////////////////////////////////////////////////////////////////////////////
  747. EglBitmap = class(Exception);
  748. EglBitmapNotSupported = class(Exception);
  749. EglBitmapSizeToLarge = class(EglBitmap);
  750. EglBitmapNonPowerOfTwo = class(EglBitmap);
  751. EglBitmapUnsupportedFormat = class(EglBitmap)
  752. public
  753. constructor Create(const aFormat: TglBitmapFormat); overload;
  754. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  755. end;
  756. ////////////////////////////////////////////////////////////////////////////////////////////////////
  757. TglBitmapRec4ui = packed record
  758. case Integer of
  759. 0: (r, g, b, a: Cardinal);
  760. 1: (arr: array[0..3] of Cardinal);
  761. end;
  762. TglBitmapRec4ub = packed record
  763. case Integer of
  764. 0: (r, g, b, a: Byte);
  765. 1: (arr: array[0..3] of Byte);
  766. end;
  767. TglBitmapRec4ul = packed record
  768. case Integer of
  769. 0: (r, g, b, a: QWord);
  770. 1: (arr: array[0..3] of QWord);
  771. end;
  772. TglBitmapFormatDescriptor = class(TObject)
  773. strict private
  774. // cached properties
  775. fBytesPerPixel: Single;
  776. fChannelCount: Integer;
  777. fMask: TglBitmapRec4ul;
  778. fRange: TglBitmapRec4ui;
  779. function GetHasRed: Boolean;
  780. function GetHasGreen: Boolean;
  781. function GetHasBlue: Boolean;
  782. function GetHasAlpha: Boolean;
  783. function GetHasColor: Boolean;
  784. function GetIsGrayscale: Boolean;
  785. protected
  786. fFormat: TglBitmapFormat;
  787. fWithAlpha: TglBitmapFormat;
  788. fWithoutAlpha: TglBitmapFormat;
  789. fOpenGLFormat: TglBitmapFormat;
  790. fRGBInverted: TglBitmapFormat;
  791. fUncompressed: TglBitmapFormat;
  792. fBitsPerPixel: Integer;
  793. fIsCompressed: Boolean;
  794. fPrecision: TglBitmapRec4ub;
  795. fShift: TglBitmapRec4ub;
  796. fglFormat: GLenum;
  797. fglInternalFormat: GLenum;
  798. fglDataFormat: GLenum;
  799. procedure SetValues; virtual;
  800. procedure CalcValues;
  801. public
  802. property Format: TglBitmapFormat read fFormat;
  803. property ChannelCount: Integer read fChannelCount;
  804. property IsCompressed: Boolean read fIsCompressed;
  805. property BitsPerPixel: Integer read fBitsPerPixel;
  806. property BytesPerPixel: Single read fBytesPerPixel;
  807. property Precision: TglBitmapRec4ub read fPrecision;
  808. property Shift: TglBitmapRec4ub read fShift;
  809. property Range: TglBitmapRec4ui read fRange;
  810. property Mask: TglBitmapRec4ul read fMask;
  811. property RGBInverted: TglBitmapFormat read fRGBInverted;
  812. property WithAlpha: TglBitmapFormat read fWithAlpha;
  813. property WithoutAlpha: TglBitmapFormat read fWithAlpha;
  814. property OpenGLFormat: TglBitmapFormat read fOpenGLFormat;
  815. property Uncompressed: TglBitmapFormat read fUncompressed;
  816. property glFormat: GLenum read fglFormat;
  817. property glInternalFormat: GLenum read fglInternalFormat;
  818. property glDataFormat: GLenum read fglDataFormat;
  819. property HasRed: Boolean read GetHasRed;
  820. property HasGreen: Boolean read GetHasGreen;
  821. property HasBlue: Boolean read GetHasBlue;
  822. property HasAlpha: Boolean read GetHasAlpha;
  823. property HasColor: Boolean read GetHasColor;
  824. property IsGrayscale: Boolean read GetIsGrayscale;
  825. constructor Create;
  826. public
  827. class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  828. end;
  829. ////////////////////////////////////////////////////////////////////////////////////////////////////
  830. TglBitmapPixelData = packed record
  831. Data: TglBitmapRec4ui;
  832. Range: TglBitmapRec4ui;
  833. Format: TglBitmapFormat;
  834. end;
  835. PglBitmapPixelData = ^TglBitmapPixelData;
  836. TglBitmapPixelPositionFields = set of (ffX, ffY);
  837. TglBitmapPixelPosition = record
  838. Fields : TglBitmapPixelPositionFields;
  839. X : Word;
  840. Y : Word;
  841. end;
  842. ////////////////////////////////////////////////////////////////////////////////////////////////////
  843. TglBitmap = class;
  844. TglBitmapFunctionRec = record
  845. Sender: TglBitmap;
  846. Size: TglBitmapPixelPosition;
  847. Position: TglBitmapPixelPosition;
  848. Source: TglBitmapPixelData;
  849. Dest: TglBitmapPixelData;
  850. Args: Pointer;
  851. end;
  852. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  853. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  854. TglBitmap = class
  855. private
  856. function GetFormatDesc: TglBitmapFormatDescriptor;
  857. protected
  858. fID: GLuint;
  859. fTarget: GLuint;
  860. fAnisotropic: Integer;
  861. fDeleteTextureOnFree: Boolean;
  862. fFreeDataOnDestroy: Boolean;
  863. fFreeDataAfterGenTexture: Boolean;
  864. fData: PByte;
  865. fIsResident: GLboolean;
  866. fBorderColor: array[0..3] of Single;
  867. fDimension: TglBitmapPixelPosition;
  868. fMipMap: TglBitmapMipMap;
  869. fFormat: TglBitmapFormat;
  870. // Mapping
  871. fPixelSize: Integer;
  872. fRowSize: Integer;
  873. // Filtering
  874. fFilterMin: GLenum;
  875. fFilterMag: GLenum;
  876. // TexturWarp
  877. fWrapS: GLenum;
  878. fWrapT: GLenum;
  879. fWrapR: GLenum;
  880. //Swizzle
  881. fSwizzle: array[0..3] of GLenum;
  882. // CustomData
  883. fFilename: String;
  884. fCustomName: String;
  885. fCustomNameW: WideString;
  886. fCustomData: Pointer;
  887. //Getter
  888. function GetWidth: Integer; virtual;
  889. function GetHeight: Integer; virtual;
  890. function GetFileWidth: Integer; virtual;
  891. function GetFileHeight: Integer; virtual;
  892. //Setter
  893. procedure SetCustomData(const aValue: Pointer);
  894. procedure SetCustomName(const aValue: String);
  895. procedure SetCustomNameW(const aValue: WideString);
  896. procedure SetFreeDataOnDestroy(const aValue: Boolean);
  897. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  898. procedure SetFormat(const aValue: TglBitmapFormat);
  899. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  900. procedure SetID(const aValue: Cardinal);
  901. procedure SetMipMap(const aValue: TglBitmapMipMap);
  902. procedure SetTarget(const aValue: Cardinal);
  903. procedure SetAnisotropic(const aValue: Integer);
  904. procedure CreateID;
  905. procedure SetupParameters(out aBuildWithGlu: Boolean);
  906. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  907. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method
  908. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  909. function FlipHorz: Boolean; virtual;
  910. function FlipVert: Boolean; virtual;
  911. property Width: Integer read GetWidth;
  912. property Height: Integer read GetHeight;
  913. property FileWidth: Integer read GetFileWidth;
  914. property FileHeight: Integer read GetFileHeight;
  915. public
  916. //Properties
  917. property ID: Cardinal read fID write SetID;
  918. property Target: Cardinal read fTarget write SetTarget;
  919. property Format: TglBitmapFormat read fFormat write SetFormat;
  920. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  921. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  922. property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc;
  923. property Filename: String read fFilename;
  924. property CustomName: String read fCustomName write SetCustomName;
  925. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  926. property CustomData: Pointer read fCustomData write SetCustomData;
  927. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  928. property FreeDataOnDestroy: Boolean read fFreeDataOnDestroy write SetFreeDataOnDestroy;
  929. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  930. property Dimension: TglBitmapPixelPosition read fDimension;
  931. property Data: PByte read fData;
  932. property IsResident: GLboolean read fIsResident;
  933. procedure AfterConstruction; override;
  934. procedure BeforeDestruction; override;
  935. procedure PrepareResType(var aResource: String; var aResType: PChar);
  936. //Load
  937. procedure LoadFromFile(const aFilename: String);
  938. procedure LoadFromStream(const aStream: TStream); virtual;
  939. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  940. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  941. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  942. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  943. //Save
  944. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  945. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  946. //Convert
  947. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  948. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  949. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  950. public
  951. //Alpha & Co
  952. {$IFDEF GLB_SDL}
  953. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  954. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  955. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  956. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  957. const aArgs: Pointer = nil): Boolean;
  958. {$ENDIF}
  959. {$IFDEF GLB_DELPHI}
  960. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  961. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  962. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  963. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  964. const aArgs: Pointer = nil): Boolean;
  965. {$ENDIF}
  966. {$IFDEF GLB_LAZARUS}
  967. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  968. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  969. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  970. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  971. const aArgs: Pointer = nil): Boolean;
  972. {$ENDIF}
  973. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  974. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  975. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  976. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  977. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  978. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  979. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  980. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  981. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  982. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  983. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  984. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  985. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  986. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  987. function RemoveAlpha: Boolean; virtual;
  988. public
  989. //Common
  990. function Clone: TglBitmap;
  991. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  992. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  993. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  994. procedure FreeData;
  995. //ColorFill
  996. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  997. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  998. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  999. //TexParameters
  1000. procedure SetFilter(const aMin, aMag: GLenum);
  1001. procedure SetWrap(
  1002. const S: GLenum = GL_CLAMP_TO_EDGE;
  1003. const T: GLenum = GL_CLAMP_TO_EDGE;
  1004. const R: GLenum = GL_CLAMP_TO_EDGE);
  1005. procedure SetSwizzle(const r, g, b, a: GLenum);
  1006. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  1007. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  1008. //Constructors
  1009. constructor Create; overload;
  1010. constructor Create(const aFileName: String); overload;
  1011. constructor Create(const aStream: TStream); overload;
  1012. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  1013. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  1014. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  1015. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  1016. private
  1017. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  1018. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  1019. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  1020. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  1021. function LoadBMP(const aStream: TStream): Boolean; virtual;
  1022. procedure SaveBMP(const aStream: TStream); virtual;
  1023. function LoadTGA(const aStream: TStream): Boolean; virtual;
  1024. procedure SaveTGA(const aStream: TStream); virtual;
  1025. function LoadDDS(const aStream: TStream): Boolean; virtual;
  1026. procedure SaveDDS(const aStream: TStream); virtual;
  1027. end;
  1028. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1029. TglBitmap1D = class(TglBitmap)
  1030. protected
  1031. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  1032. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  1033. procedure UploadData(const aBuildWithGlu: Boolean);
  1034. public
  1035. property Width;
  1036. procedure AfterConstruction; override;
  1037. function FlipHorz: Boolean; override;
  1038. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  1039. end;
  1040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1041. TglBitmap2D = class(TglBitmap)
  1042. protected
  1043. fLines: array of PByte;
  1044. function GetScanline(const aIndex: Integer): Pointer;
  1045. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  1046. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  1047. procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  1048. public
  1049. property Width;
  1050. property Height;
  1051. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  1052. procedure AfterConstruction; override;
  1053. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  1054. procedure GetDataFromTexture;
  1055. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  1056. function FlipHorz: Boolean; override;
  1057. function FlipVert: Boolean; override;
  1058. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  1059. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  1060. end;
  1061. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1062. TglBitmapCubeMap = class(TglBitmap2D)
  1063. protected
  1064. fGenMode: Integer;
  1065. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  1066. public
  1067. procedure AfterConstruction; override;
  1068. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  1069. procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  1070. procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  1071. end;
  1072. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1073. TglBitmapNormalMap = class(TglBitmapCubeMap)
  1074. public
  1075. procedure AfterConstruction; override;
  1076. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  1077. end;
  1078. const
  1079. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1080. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1081. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1082. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1083. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1084. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1085. procedure glBitmapSetDefaultWrap(
  1086. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1087. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1088. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1089. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1090. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1091. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1092. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1093. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1094. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1095. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1096. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1097. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1098. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1099. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1100. function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
  1101. var
  1102. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1103. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1104. glBitmapDefaultFormat: TglBitmapFormat;
  1105. glBitmapDefaultMipmap: TglBitmapMipMap;
  1106. glBitmapDefaultFilterMin: Cardinal;
  1107. glBitmapDefaultFilterMag: Cardinal;
  1108. glBitmapDefaultWrapS: Cardinal;
  1109. glBitmapDefaultWrapT: Cardinal;
  1110. glBitmapDefaultWrapR: Cardinal;
  1111. glDefaultSwizzle: array[0..3] of GLenum;
  1112. {$IFDEF GLB_DELPHI}
  1113. function CreateGrayPalette: HPALETTE;
  1114. {$ENDIF}
  1115. implementation
  1116. uses
  1117. Math, syncobjs, typinfo
  1118. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1119. type
  1120. {$IFNDEF fpc}
  1121. QWord = System.UInt64;
  1122. PQWord = ^QWord;
  1123. PtrInt = Longint;
  1124. PtrUInt = DWord;
  1125. {$ENDIF}
  1126. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1127. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1128. public
  1129. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1130. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1131. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1132. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1133. function CreateMappingData: Pointer; virtual;
  1134. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1135. function IsEmpty: Boolean; virtual;
  1136. function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
  1137. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1138. public
  1139. class procedure Init;
  1140. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1141. class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1142. class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
  1143. class procedure Clear;
  1144. class procedure Finalize;
  1145. end;
  1146. TFormatDescriptorClass = class of TFormatDescriptor;
  1147. TfdEmpty = class(TFormatDescriptor);
  1148. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1149. TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
  1150. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1151. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1152. end;
  1153. TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
  1154. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1155. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1156. end;
  1157. TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
  1158. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1159. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1160. end;
  1161. TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
  1162. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1163. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1164. end;
  1165. TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
  1166. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1167. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1168. end;
  1169. TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1170. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1171. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1172. end;
  1173. TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
  1174. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1175. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1176. end;
  1177. TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
  1178. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1179. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1180. end;
  1181. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1182. TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
  1183. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1184. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1185. end;
  1186. TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
  1187. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1188. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1189. end;
  1190. TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
  1191. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1192. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1193. end;
  1194. TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
  1195. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1196. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1197. end;
  1198. TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
  1199. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1200. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1201. end;
  1202. TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
  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. TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  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. TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
  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. TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
  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. TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  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. TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (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. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1227. TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
  1228. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1229. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1230. end;
  1231. TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
  1232. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1233. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1234. end;
  1235. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1236. TfdAlpha4ub1 = class(TfdAlphaUB1)
  1237. procedure SetValues; override;
  1238. end;
  1239. TfdAlpha8ub1 = class(TfdAlphaUB1)
  1240. procedure SetValues; override;
  1241. end;
  1242. TfdAlpha16us1 = class(TfdAlphaUS1)
  1243. procedure SetValues; override;
  1244. end;
  1245. TfdLuminance4ub1 = class(TfdLuminanceUB1)
  1246. procedure SetValues; override;
  1247. end;
  1248. TfdLuminance8ub1 = class(TfdLuminanceUB1)
  1249. procedure SetValues; override;
  1250. end;
  1251. TfdLuminance16us1 = class(TfdLuminanceUS1)
  1252. procedure SetValues; override;
  1253. end;
  1254. TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
  1255. procedure SetValues; override;
  1256. end;
  1257. TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
  1258. procedure SetValues; override;
  1259. end;
  1260. TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
  1261. procedure SetValues; override;
  1262. end;
  1263. TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
  1264. procedure SetValues; override;
  1265. end;
  1266. TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
  1267. procedure SetValues; override;
  1268. end;
  1269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1270. TfdR3G3B2ub1 = class(TfdUniversalUB1)
  1271. procedure SetValues; override;
  1272. end;
  1273. TfdRGBX4us1 = class(TfdUniversalUS1)
  1274. procedure SetValues; override;
  1275. end;
  1276. TfdXRGB4us1 = class(TfdUniversalUS1)
  1277. procedure SetValues; override;
  1278. end;
  1279. TfdR5G6B5us1 = class(TfdUniversalUS1)
  1280. procedure SetValues; override;
  1281. end;
  1282. TfdRGB5X1us1 = class(TfdUniversalUS1)
  1283. procedure SetValues; override;
  1284. end;
  1285. TfdX1RGB5us1 = class(TfdUniversalUS1)
  1286. procedure SetValues; override;
  1287. end;
  1288. TfdRGB8ub3 = class(TfdRGBub3)
  1289. procedure SetValues; override;
  1290. end;
  1291. TfdRGBX8ui1 = class(TfdUniversalUI1)
  1292. procedure SetValues; override;
  1293. end;
  1294. TfdXRGB8ui1 = class(TfdUniversalUI1)
  1295. procedure SetValues; override;
  1296. end;
  1297. TfdRGB10X2ui1 = class(TfdUniversalUI1)
  1298. procedure SetValues; override;
  1299. end;
  1300. TfdX2RGB10ui1 = class(TfdUniversalUI1)
  1301. procedure SetValues; override;
  1302. end;
  1303. TfdRGB16us3 = class(TfdRGBus3)
  1304. procedure SetValues; override;
  1305. end;
  1306. TfdRGBA4us1 = class(TfdUniversalUS1)
  1307. procedure SetValues; override;
  1308. end;
  1309. TfdARGB4us1 = class(TfdUniversalUS1)
  1310. procedure SetValues; override;
  1311. end;
  1312. TfdRGB5A1us1 = class(TfdUniversalUS1)
  1313. procedure SetValues; override;
  1314. end;
  1315. TfdA1RGB5us1 = class(TfdUniversalUS1)
  1316. procedure SetValues; override;
  1317. end;
  1318. TfdRGBA8ui1 = class(TfdUniversalUI1)
  1319. procedure SetValues; override;
  1320. end;
  1321. TfdARGB8ui1 = class(TfdUniversalUI1)
  1322. procedure SetValues; override;
  1323. end;
  1324. TfdRGBA8ub4 = class(TfdRGBAub4)
  1325. procedure SetValues; override;
  1326. end;
  1327. TfdRGB10A2ui1 = class(TfdUniversalUI1)
  1328. procedure SetValues; override;
  1329. end;
  1330. TfdA2RGB10ui1 = class(TfdUniversalUI1)
  1331. procedure SetValues; override;
  1332. end;
  1333. TfdRGBA16us4 = class(TfdRGBAus4)
  1334. procedure SetValues; override;
  1335. end;
  1336. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1337. TfdBGRX4us1 = class(TfdUniversalUS1)
  1338. procedure SetValues; override;
  1339. end;
  1340. TfdXBGR4us1 = class(TfdUniversalUS1)
  1341. procedure SetValues; override;
  1342. end;
  1343. TfdB5G6R5us1 = class(TfdUniversalUS1)
  1344. procedure SetValues; override;
  1345. end;
  1346. TfdBGR5X1us1 = class(TfdUniversalUS1)
  1347. procedure SetValues; override;
  1348. end;
  1349. TfdX1BGR5us1 = class(TfdUniversalUS1)
  1350. procedure SetValues; override;
  1351. end;
  1352. TfdBGR8ub3 = class(TfdBGRub3)
  1353. procedure SetValues; override;
  1354. end;
  1355. TfdBGRX8ui1 = class(TfdUniversalUI1)
  1356. procedure SetValues; override;
  1357. end;
  1358. TfdXBGR8ui1 = class(TfdUniversalUI1)
  1359. procedure SetValues; override;
  1360. end;
  1361. TfdBGR10X2ui1 = class(TfdUniversalUI1)
  1362. procedure SetValues; override;
  1363. end;
  1364. TfdX2BGR10ui1 = class(TfdUniversalUI1)
  1365. procedure SetValues; override;
  1366. end;
  1367. TfdBGR16us3 = class(TfdBGRus3)
  1368. procedure SetValues; override;
  1369. end;
  1370. TfdBGRA4us1 = class(TfdUniversalUS1)
  1371. procedure SetValues; override;
  1372. end;
  1373. TfdABGR4us1 = class(TfdUniversalUS1)
  1374. procedure SetValues; override;
  1375. end;
  1376. TfdBGR5A1us1 = class(TfdUniversalUS1)
  1377. procedure SetValues; override;
  1378. end;
  1379. TfdA1BGR5us1 = class(TfdUniversalUS1)
  1380. procedure SetValues; override;
  1381. end;
  1382. TfdBGRA8ui1 = class(TfdUniversalUI1)
  1383. procedure SetValues; override;
  1384. end;
  1385. TfdABGR8ui1 = class(TfdUniversalUI1)
  1386. procedure SetValues; override;
  1387. end;
  1388. TfdBGRA8ub4 = class(TfdBGRAub4)
  1389. procedure SetValues; override;
  1390. end;
  1391. TfdBGR10A2ui1 = class(TfdUniversalUI1)
  1392. procedure SetValues; override;
  1393. end;
  1394. TfdA2BGR10ui1 = class(TfdUniversalUI1)
  1395. procedure SetValues; override;
  1396. end;
  1397. TfdBGRA16us4 = class(TfdBGRAus4)
  1398. procedure SetValues; override;
  1399. end;
  1400. TfdDepth16us1 = class(TfdDepthUS1)
  1401. procedure SetValues; override;
  1402. end;
  1403. TfdDepth24ui1 = class(TfdDepthUI1)
  1404. procedure SetValues; override;
  1405. end;
  1406. TfdDepth32ui1 = class(TfdDepthUI1)
  1407. procedure SetValues; override;
  1408. end;
  1409. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1410. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1411. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1412. procedure SetValues; override;
  1413. end;
  1414. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1415. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1416. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1417. procedure SetValues; override;
  1418. end;
  1419. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1420. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1421. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1422. procedure SetValues; override;
  1423. end;
  1424. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1425. TbmpBitfieldFormat = class(TFormatDescriptor)
  1426. public
  1427. procedure SetValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
  1428. procedure SetValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1429. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1430. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1431. end;
  1432. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1433. TbmpColorTableEnty = packed record
  1434. b, g, r, a: Byte;
  1435. end;
  1436. TbmpColorTable = array of TbmpColorTableEnty;
  1437. TbmpColorTableFormat = class(TFormatDescriptor)
  1438. private
  1439. fBitsPerPixel: Integer;
  1440. fColorTable: TbmpColorTable;
  1441. protected
  1442. procedure SetValues; override; overload;
  1443. public
  1444. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1445. property BitsPerPixel: Integer read fBitsPerPixel write fBitsPerPixel;
  1446. procedure SetValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1447. procedure CalcValues;
  1448. procedure CreateColorTable;
  1449. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1450. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1451. destructor Destroy; override;
  1452. end;
  1453. const
  1454. LUMINANCE_WEIGHT_R = 0.30;
  1455. LUMINANCE_WEIGHT_G = 0.59;
  1456. LUMINANCE_WEIGHT_B = 0.11;
  1457. ALPHA_WEIGHT_R = 0.30;
  1458. ALPHA_WEIGHT_G = 0.59;
  1459. ALPHA_WEIGHT_B = 0.11;
  1460. DEPTH_WEIGHT_R = 0.333333333;
  1461. DEPTH_WEIGHT_G = 0.333333333;
  1462. DEPTH_WEIGHT_B = 0.333333333;
  1463. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1464. TfdEmpty,
  1465. TfdAlpha4ub1,
  1466. TfdAlpha8ub1,
  1467. TfdAlpha16us1,
  1468. TfdLuminance4ub1,
  1469. TfdLuminance8ub1,
  1470. TfdLuminance16us1,
  1471. TfdLuminance4Alpha4ub2,
  1472. TfdLuminance6Alpha2ub2,
  1473. TfdLuminance8Alpha8ub2,
  1474. TfdLuminance12Alpha4us2,
  1475. TfdLuminance16Alpha16us2,
  1476. TfdR3G3B2ub1,
  1477. TfdRGBX4us1,
  1478. TfdXRGB4us1,
  1479. TfdR5G6B5us1,
  1480. TfdRGB5X1us1,
  1481. TfdX1RGB5us1,
  1482. TfdRGB8ub3,
  1483. TfdRGBX8ui1,
  1484. TfdXRGB8ui1,
  1485. TfdRGB10X2ui1,
  1486. TfdX2RGB10ui1,
  1487. TfdRGB16us3,
  1488. TfdRGBA4us1,
  1489. TfdARGB4us1,
  1490. TfdRGB5A1us1,
  1491. TfdA1RGB5us1,
  1492. TfdRGBA8ui1,
  1493. TfdARGB8ui1,
  1494. TfdRGBA8ub4,
  1495. TfdRGB10A2ui1,
  1496. TfdA2RGB10ui1,
  1497. TfdRGBA16us4,
  1498. TfdBGRX4us1,
  1499. TfdXBGR4us1,
  1500. TfdB5G6R5us1,
  1501. TfdBGR5X1us1,
  1502. TfdX1BGR5us1,
  1503. TfdBGR8ub3,
  1504. TfdBGRX8ui1,
  1505. TfdXBGR8ui1,
  1506. TfdBGR10X2ui1,
  1507. TfdX2BGR10ui1,
  1508. TfdBGR16us3,
  1509. TfdBGRA4us1,
  1510. TfdABGR4us1,
  1511. TfdBGR5A1us1,
  1512. TfdA1BGR5us1,
  1513. TfdBGRA8ui1,
  1514. TfdABGR8ui1,
  1515. TfdBGRA8ub4,
  1516. TfdBGR10A2ui1,
  1517. TfdA2BGR10ui1,
  1518. TfdBGRA16us4,
  1519. TfdDepth16us1,
  1520. TfdDepth24ui1,
  1521. TfdDepth32ui1,
  1522. TfdS3tcDtx1RGBA,
  1523. TfdS3tcDtx3RGBA,
  1524. TfdS3tcDtx5RGBA
  1525. );
  1526. var
  1527. FormatDescriptorCS: TCriticalSection;
  1528. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1529. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1530. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1531. begin
  1532. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1533. end;
  1534. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1535. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1536. begin
  1537. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1538. end;
  1539. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1540. function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
  1541. begin
  1542. result.Fields := [];
  1543. if X >= 0 then
  1544. result.Fields := result.Fields + [ffX];
  1545. if Y >= 0 then
  1546. result.Fields := result.Fields + [ffY];
  1547. result.X := Max(0, X);
  1548. result.Y := Max(0, Y);
  1549. end;
  1550. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1551. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1552. begin
  1553. result.r := r;
  1554. result.g := g;
  1555. result.b := b;
  1556. result.a := a;
  1557. end;
  1558. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1559. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1560. begin
  1561. result.r := r;
  1562. result.g := g;
  1563. result.b := b;
  1564. result.a := a;
  1565. end;
  1566. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1567. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1568. begin
  1569. result.r := r;
  1570. result.g := g;
  1571. result.b := b;
  1572. result.a := a;
  1573. end;
  1574. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1575. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1576. var
  1577. i: Integer;
  1578. begin
  1579. result := false;
  1580. for i := 0 to high(r1.arr) do
  1581. if (r1.arr[i] <> r2.arr[i]) then
  1582. exit;
  1583. result := true;
  1584. end;
  1585. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1586. function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
  1587. var
  1588. desc: TFormatDescriptor;
  1589. p, tmp: PByte;
  1590. x, y, i: Integer;
  1591. md: Pointer;
  1592. px: TglBitmapPixelData;
  1593. begin
  1594. result := nil;
  1595. desc := TFormatDescriptor.Get(aFormat);
  1596. if (desc.IsCompressed) or (desc.glFormat = 0) then
  1597. exit;
  1598. p := GetMem(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
  1599. md := desc.CreateMappingData;
  1600. try
  1601. tmp := p;
  1602. desc.PreparePixel(px);
  1603. for y := 0 to 4 do
  1604. for x := 0 to 4 do begin
  1605. px.Data := glBitmapRec4ui(0, 0, 0, 0);
  1606. for i := 0 to 3 do begin
  1607. if ((y < 3) and (y = i)) or
  1608. ((y = 3) and (i < 3)) or
  1609. ((y = 4) and (i = 3))
  1610. then
  1611. px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
  1612. else if ((y < 4) and (i = 3)) or
  1613. ((y = 4) and (i < 3))
  1614. then
  1615. px.Data.arr[i] := px.Range.arr[i]
  1616. else
  1617. px.Data.arr[i] := 0; //px.Range.arr[i];
  1618. end;
  1619. desc.Map(px, tmp, md);
  1620. end;
  1621. finally
  1622. desc.FreeMappingData(md);
  1623. end;
  1624. result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
  1625. result.FreeDataOnDestroy := true;
  1626. result.FreeDataAfterGenTexture := false;
  1627. result.SetFilter(GL_NEAREST, GL_NEAREST);
  1628. end;
  1629. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1630. function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
  1631. begin
  1632. result.r := r;
  1633. result.g := g;
  1634. result.b := b;
  1635. result.a := a;
  1636. end;
  1637. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1638. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1639. begin
  1640. result := [];
  1641. if (aFormat in [
  1642. //8bpp
  1643. tfAlpha4ub1, tfAlpha8ub1,
  1644. tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
  1645. //16bpp
  1646. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1647. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  1648. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
  1649. //24bpp
  1650. tfBGR8ub3, tfRGB8ub3,
  1651. //32bpp
  1652. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  1653. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
  1654. then
  1655. result := result + [ ftBMP ];
  1656. if (aFormat in [
  1657. //8bbp
  1658. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
  1659. //16bbp
  1660. tfAlpha16us1, tfLuminance16us1,
  1661. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1662. tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
  1663. //24bbp
  1664. tfBGR8ub3,
  1665. //32bbp
  1666. tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
  1667. tfDepth24ui1, tfDepth32ui1])
  1668. then
  1669. result := result + [ftTGA];
  1670. if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
  1671. result := result + [ftDDS];
  1672. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1673. if aFormat in [
  1674. tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
  1675. tfRGB8ub3, tfRGBA8ui1,
  1676. tfBGR8ub3, tfBGRA8ui1] then
  1677. result := result + [ftPNG];
  1678. {$ENDIF}
  1679. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1680. if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
  1681. result := result + [ftJPEG];
  1682. {$ENDIF}
  1683. end;
  1684. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1685. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1686. begin
  1687. while (aNumber and 1) = 0 do
  1688. aNumber := aNumber shr 1;
  1689. result := aNumber = 1;
  1690. end;
  1691. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1692. function GetTopMostBit(aBitSet: QWord): Integer;
  1693. begin
  1694. result := 0;
  1695. while aBitSet > 0 do begin
  1696. inc(result);
  1697. aBitSet := aBitSet shr 1;
  1698. end;
  1699. end;
  1700. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1701. function CountSetBits(aBitSet: QWord): Integer;
  1702. begin
  1703. result := 0;
  1704. while aBitSet > 0 do begin
  1705. if (aBitSet and 1) = 1 then
  1706. inc(result);
  1707. aBitSet := aBitSet shr 1;
  1708. end;
  1709. end;
  1710. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1711. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1712. begin
  1713. result := Trunc(
  1714. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1715. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1716. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1717. end;
  1718. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1719. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1720. begin
  1721. result := Trunc(
  1722. DEPTH_WEIGHT_R * aPixel.Data.r +
  1723. DEPTH_WEIGHT_G * aPixel.Data.g +
  1724. DEPTH_WEIGHT_B * aPixel.Data.b);
  1725. end;
  1726. {$IFDEF GLB_NATIVE_OGL}
  1727. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1728. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1729. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1730. var
  1731. GL_LibHandle: Pointer = nil;
  1732. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
  1733. begin
  1734. if not Assigned(aLibHandle) then
  1735. aLibHandle := GL_LibHandle;
  1736. {$IF DEFINED(GLB_WIN)}
  1737. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1738. if Assigned(result) then
  1739. exit;
  1740. if Assigned(wglGetProcAddress) then
  1741. result := wglGetProcAddress(aProcName);
  1742. {$ELSEIF DEFINED(GLB_LINUX)}
  1743. if Assigned(glXGetProcAddress) then begin
  1744. result := glXGetProcAddress(aProcName);
  1745. if Assigned(result) then
  1746. exit;
  1747. end;
  1748. if Assigned(glXGetProcAddressARB) then begin
  1749. result := glXGetProcAddressARB(aProcName);
  1750. if Assigned(result) then
  1751. exit;
  1752. end;
  1753. result := dlsym(aLibHandle, aProcName);
  1754. {$IFEND}
  1755. if not Assigned(result) and aRaiseOnErr then
  1756. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1757. end;
  1758. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1759. var
  1760. GLU_LibHandle: Pointer = nil;
  1761. OpenGLInitialized: Boolean;
  1762. InitOpenGLCS: TCriticalSection;
  1763. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1764. procedure glbInitOpenGL;
  1765. ////////////////////////////////////////////////////////////////////////////////
  1766. function glbLoadLibrary(const aName: PChar): Pointer;
  1767. begin
  1768. {$IF DEFINED(GLB_WIN)}
  1769. result := {%H-}Pointer(LoadLibrary(aName));
  1770. {$ELSEIF DEFINED(GLB_LINUX)}
  1771. result := dlopen(Name, RTLD_LAZY);
  1772. {$ELSE}
  1773. result := nil;
  1774. {$IFEND}
  1775. end;
  1776. ////////////////////////////////////////////////////////////////////////////////
  1777. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1778. begin
  1779. result := false;
  1780. if not Assigned(aLibHandle) then
  1781. exit;
  1782. {$IF DEFINED(GLB_WIN)}
  1783. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1784. {$ELSEIF DEFINED(GLB_LINUX)}
  1785. Result := dlclose(aLibHandle) = 0;
  1786. {$IFEND}
  1787. end;
  1788. begin
  1789. if Assigned(GL_LibHandle) then
  1790. glbFreeLibrary(GL_LibHandle);
  1791. if Assigned(GLU_LibHandle) then
  1792. glbFreeLibrary(GLU_LibHandle);
  1793. GL_LibHandle := glbLoadLibrary(libopengl);
  1794. if not Assigned(GL_LibHandle) then
  1795. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1796. GLU_LibHandle := glbLoadLibrary(libglu);
  1797. if not Assigned(GLU_LibHandle) then
  1798. raise EglBitmap.Create('unable to load library: ' + libglu);
  1799. {$IF DEFINED(GLB_WIN)}
  1800. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1801. {$ELSEIF DEFINED(GLB_LINUX)}
  1802. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1803. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1804. {$IFEND}
  1805. glEnable := glbGetProcAddress('glEnable');
  1806. glDisable := glbGetProcAddress('glDisable');
  1807. glGetString := glbGetProcAddress('glGetString');
  1808. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1809. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1810. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1811. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1812. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1813. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1814. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1815. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1816. glTexGeni := glbGetProcAddress('glTexGeni');
  1817. glGenTextures := glbGetProcAddress('glGenTextures');
  1818. glBindTexture := glbGetProcAddress('glBindTexture');
  1819. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1820. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1821. glReadPixels := glbGetProcAddress('glReadPixels');
  1822. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1823. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1824. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1825. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1826. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1827. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1828. end;
  1829. {$ENDIF}
  1830. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1831. procedure glbReadOpenGLExtensions;
  1832. var
  1833. Buffer: AnsiString;
  1834. MajorVersion, MinorVersion: Integer;
  1835. ///////////////////////////////////////////////////////////////////////////////////////////
  1836. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1837. var
  1838. Separator: Integer;
  1839. begin
  1840. aMinor := 0;
  1841. aMajor := 0;
  1842. Separator := Pos(AnsiString('.'), aBuffer);
  1843. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1844. (aBuffer[Separator - 1] in ['0'..'9']) and
  1845. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1846. Dec(Separator);
  1847. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1848. Dec(Separator);
  1849. Delete(aBuffer, 1, Separator);
  1850. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1851. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1852. Inc(Separator);
  1853. Delete(aBuffer, Separator, 255);
  1854. Separator := Pos(AnsiString('.'), aBuffer);
  1855. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1856. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1857. end;
  1858. end;
  1859. ///////////////////////////////////////////////////////////////////////////////////////////
  1860. function CheckExtension(const Extension: AnsiString): Boolean;
  1861. var
  1862. ExtPos: Integer;
  1863. begin
  1864. ExtPos := Pos(Extension, Buffer);
  1865. result := ExtPos > 0;
  1866. if result then
  1867. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1868. end;
  1869. ///////////////////////////////////////////////////////////////////////////////////////////
  1870. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1871. begin
  1872. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1873. end;
  1874. begin
  1875. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1876. InitOpenGLCS.Enter;
  1877. try
  1878. if not OpenGLInitialized then begin
  1879. glbInitOpenGL;
  1880. OpenGLInitialized := true;
  1881. end;
  1882. finally
  1883. InitOpenGLCS.Leave;
  1884. end;
  1885. {$ENDIF}
  1886. // Version
  1887. Buffer := glGetString(GL_VERSION);
  1888. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1889. GL_VERSION_1_2 := CheckVersion(1, 2);
  1890. GL_VERSION_1_3 := CheckVersion(1, 3);
  1891. GL_VERSION_1_4 := CheckVersion(1, 4);
  1892. GL_VERSION_2_0 := CheckVersion(2, 0);
  1893. GL_VERSION_3_3 := CheckVersion(3, 3);
  1894. // Extensions
  1895. Buffer := glGetString(GL_EXTENSIONS);
  1896. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1897. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1898. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1899. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1900. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1901. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1902. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1903. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1904. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1905. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1906. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1907. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1908. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1909. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1910. if GL_VERSION_1_3 then begin
  1911. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1912. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1913. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1914. end else begin
  1915. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false);
  1916. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false);
  1917. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
  1918. end;
  1919. end;
  1920. {$ENDIF}
  1921. {$IFDEF GLB_SDL_IMAGE}
  1922. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1923. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1924. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1925. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1926. begin
  1927. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1928. end;
  1929. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1930. begin
  1931. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1932. end;
  1933. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1934. begin
  1935. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1936. end;
  1937. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1938. begin
  1939. result := 0;
  1940. end;
  1941. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1942. begin
  1943. result := SDL_AllocRW;
  1944. if result = nil then
  1945. raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1946. result^.seek := glBitmapRWseek;
  1947. result^.read := glBitmapRWread;
  1948. result^.write := glBitmapRWwrite;
  1949. result^.close := glBitmapRWclose;
  1950. result^.unknown.data1 := Stream;
  1951. end;
  1952. {$ENDIF}
  1953. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1954. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1955. begin
  1956. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1957. end;
  1958. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1959. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1960. begin
  1961. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1962. end;
  1963. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1964. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1965. begin
  1966. glBitmapDefaultMipmap := aValue;
  1967. end;
  1968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1969. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1970. begin
  1971. glBitmapDefaultFormat := aFormat;
  1972. end;
  1973. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1974. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1975. begin
  1976. glBitmapDefaultFilterMin := aMin;
  1977. glBitmapDefaultFilterMag := aMag;
  1978. end;
  1979. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1980. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1981. begin
  1982. glBitmapDefaultWrapS := S;
  1983. glBitmapDefaultWrapT := T;
  1984. glBitmapDefaultWrapR := R;
  1985. end;
  1986. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1987. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1988. begin
  1989. glDefaultSwizzle[0] := r;
  1990. glDefaultSwizzle[1] := g;
  1991. glDefaultSwizzle[2] := b;
  1992. glDefaultSwizzle[3] := a;
  1993. end;
  1994. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1995. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1996. begin
  1997. result := glBitmapDefaultDeleteTextureOnFree;
  1998. end;
  1999. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2000. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  2001. begin
  2002. result := glBitmapDefaultFreeDataAfterGenTextures;
  2003. end;
  2004. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2005. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  2006. begin
  2007. result := glBitmapDefaultMipmap;
  2008. end;
  2009. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2010. function glBitmapGetDefaultFormat: TglBitmapFormat;
  2011. begin
  2012. result := glBitmapDefaultFormat;
  2013. end;
  2014. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2015. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  2016. begin
  2017. aMin := glBitmapDefaultFilterMin;
  2018. aMag := glBitmapDefaultFilterMag;
  2019. end;
  2020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2021. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  2022. begin
  2023. S := glBitmapDefaultWrapS;
  2024. T := glBitmapDefaultWrapT;
  2025. R := glBitmapDefaultWrapR;
  2026. end;
  2027. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2028. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  2029. begin
  2030. r := glDefaultSwizzle[0];
  2031. g := glDefaultSwizzle[1];
  2032. b := glDefaultSwizzle[2];
  2033. a := glDefaultSwizzle[3];
  2034. end;
  2035. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2036. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2037. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2038. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  2039. var
  2040. w, h: Integer;
  2041. begin
  2042. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  2043. w := Max(1, aSize.X);
  2044. h := Max(1, aSize.Y);
  2045. result := GetSize(w, h);
  2046. end else
  2047. result := 0;
  2048. end;
  2049. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2050. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  2051. begin
  2052. result := 0;
  2053. if (aWidth <= 0) or (aHeight <= 0) then
  2054. exit;
  2055. result := Ceil(aWidth * aHeight * BytesPerPixel);
  2056. end;
  2057. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2058. function TFormatDescriptor.CreateMappingData: Pointer;
  2059. begin
  2060. result := nil;
  2061. end;
  2062. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2063. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2064. begin
  2065. //DUMMY
  2066. end;
  2067. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2068. function TFormatDescriptor.IsEmpty: Boolean;
  2069. begin
  2070. result := (fFormat = tfEmpty);
  2071. end;
  2072. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2073. function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
  2074. var
  2075. i: Integer;
  2076. m: TglBitmapRec4ul;
  2077. begin
  2078. result := false;
  2079. if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
  2080. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2081. m := Mask;
  2082. for i := 0 to 3 do
  2083. if (aMask.arr[i] <> m.arr[i]) then
  2084. exit;
  2085. result := true;
  2086. end;
  2087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2088. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2089. begin
  2090. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2091. aPixel.Data := Range;
  2092. aPixel.Format := fFormat;
  2093. aPixel.Range := Range;
  2094. end;
  2095. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2096. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2097. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2098. procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2099. begin
  2100. aData^ := aPixel.Data.a;
  2101. inc(aData);
  2102. end;
  2103. procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2104. begin
  2105. aPixel.Data.r := 0;
  2106. aPixel.Data.g := 0;
  2107. aPixel.Data.b := 0;
  2108. aPixel.Data.a := aData^;
  2109. inc(aData);
  2110. end;
  2111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2112. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2113. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2114. procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2115. begin
  2116. aData^ := LuminanceWeight(aPixel);
  2117. inc(aData);
  2118. end;
  2119. procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2120. begin
  2121. aPixel.Data.r := aData^;
  2122. aPixel.Data.g := aData^;
  2123. aPixel.Data.b := aData^;
  2124. aPixel.Data.a := 0;
  2125. inc(aData);
  2126. end;
  2127. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2128. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2129. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2130. procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2131. var
  2132. i: Integer;
  2133. begin
  2134. aData^ := 0;
  2135. for i := 0 to 3 do
  2136. if (Range.arr[i] > 0) then
  2137. aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2138. inc(aData);
  2139. end;
  2140. procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2141. var
  2142. i: Integer;
  2143. begin
  2144. for i := 0 to 3 do
  2145. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
  2146. inc(aData);
  2147. end;
  2148. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2149. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2150. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2151. procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2152. begin
  2153. inherited Map(aPixel, aData, aMapData);
  2154. aData^ := aPixel.Data.a;
  2155. inc(aData);
  2156. end;
  2157. procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2158. begin
  2159. inherited Unmap(aData, aPixel, aMapData);
  2160. aPixel.Data.a := aData^;
  2161. inc(aData);
  2162. end;
  2163. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2164. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2165. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2166. procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2167. begin
  2168. aData^ := aPixel.Data.r;
  2169. inc(aData);
  2170. aData^ := aPixel.Data.g;
  2171. inc(aData);
  2172. aData^ := aPixel.Data.b;
  2173. inc(aData);
  2174. end;
  2175. procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2176. begin
  2177. aPixel.Data.r := aData^;
  2178. inc(aData);
  2179. aPixel.Data.g := aData^;
  2180. inc(aData);
  2181. aPixel.Data.b := aData^;
  2182. inc(aData);
  2183. aPixel.Data.a := 0;
  2184. end;
  2185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2186. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2188. procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2189. begin
  2190. aData^ := aPixel.Data.b;
  2191. inc(aData);
  2192. aData^ := aPixel.Data.g;
  2193. inc(aData);
  2194. aData^ := aPixel.Data.r;
  2195. inc(aData);
  2196. end;
  2197. procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2198. begin
  2199. aPixel.Data.b := aData^;
  2200. inc(aData);
  2201. aPixel.Data.g := aData^;
  2202. inc(aData);
  2203. aPixel.Data.r := aData^;
  2204. inc(aData);
  2205. aPixel.Data.a := 0;
  2206. end;
  2207. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2208. //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2209. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2210. procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2211. begin
  2212. inherited Map(aPixel, aData, aMapData);
  2213. aData^ := aPixel.Data.a;
  2214. inc(aData);
  2215. end;
  2216. procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2217. begin
  2218. inherited Unmap(aData, aPixel, aMapData);
  2219. aPixel.Data.a := aData^;
  2220. inc(aData);
  2221. end;
  2222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2223. //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2225. procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2226. begin
  2227. inherited Map(aPixel, aData, aMapData);
  2228. aData^ := aPixel.Data.a;
  2229. inc(aData);
  2230. end;
  2231. procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2232. begin
  2233. inherited Unmap(aData, aPixel, aMapData);
  2234. aPixel.Data.a := aData^;
  2235. inc(aData);
  2236. end;
  2237. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2238. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2239. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2240. procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2241. begin
  2242. PWord(aData)^ := aPixel.Data.a;
  2243. inc(aData, 2);
  2244. end;
  2245. procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2246. begin
  2247. aPixel.Data.r := 0;
  2248. aPixel.Data.g := 0;
  2249. aPixel.Data.b := 0;
  2250. aPixel.Data.a := PWord(aData)^;
  2251. inc(aData, 2);
  2252. end;
  2253. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2254. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2255. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2256. procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2257. begin
  2258. PWord(aData)^ := LuminanceWeight(aPixel);
  2259. inc(aData, 2);
  2260. end;
  2261. procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2262. begin
  2263. aPixel.Data.r := PWord(aData)^;
  2264. aPixel.Data.g := PWord(aData)^;
  2265. aPixel.Data.b := PWord(aData)^;
  2266. aPixel.Data.a := 0;
  2267. inc(aData, 2);
  2268. end;
  2269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2270. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2271. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2272. procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2273. var
  2274. i: Integer;
  2275. begin
  2276. PWord(aData)^ := 0;
  2277. for i := 0 to 3 do
  2278. if (Range.arr[i] > 0) then
  2279. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2280. inc(aData, 2);
  2281. end;
  2282. procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2283. var
  2284. i: Integer;
  2285. begin
  2286. for i := 0 to 3 do
  2287. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2288. inc(aData, 2);
  2289. end;
  2290. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2291. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2292. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2293. procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2294. begin
  2295. PWord(aData)^ := DepthWeight(aPixel);
  2296. inc(aData, 2);
  2297. end;
  2298. procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2299. begin
  2300. aPixel.Data.r := PWord(aData)^;
  2301. aPixel.Data.g := PWord(aData)^;
  2302. aPixel.Data.b := PWord(aData)^;
  2303. aPixel.Data.a := PWord(aData)^;;
  2304. inc(aData, 2);
  2305. end;
  2306. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2307. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2308. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2309. procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2310. begin
  2311. inherited Map(aPixel, aData, aMapData);
  2312. PWord(aData)^ := aPixel.Data.a;
  2313. inc(aData, 2);
  2314. end;
  2315. procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2316. begin
  2317. inherited Unmap(aData, aPixel, aMapData);
  2318. aPixel.Data.a := PWord(aData)^;
  2319. inc(aData, 2);
  2320. end;
  2321. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2322. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2323. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2324. procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2325. begin
  2326. PWord(aData)^ := aPixel.Data.r;
  2327. inc(aData, 2);
  2328. PWord(aData)^ := aPixel.Data.g;
  2329. inc(aData, 2);
  2330. PWord(aData)^ := aPixel.Data.b;
  2331. inc(aData, 2);
  2332. end;
  2333. procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2334. begin
  2335. aPixel.Data.r := PWord(aData)^;
  2336. inc(aData, 2);
  2337. aPixel.Data.g := PWord(aData)^;
  2338. inc(aData, 2);
  2339. aPixel.Data.b := PWord(aData)^;
  2340. inc(aData, 2);
  2341. aPixel.Data.a := 0;
  2342. end;
  2343. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2344. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2345. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2346. procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2347. begin
  2348. PWord(aData)^ := aPixel.Data.b;
  2349. inc(aData, 2);
  2350. PWord(aData)^ := aPixel.Data.g;
  2351. inc(aData, 2);
  2352. PWord(aData)^ := aPixel.Data.r;
  2353. inc(aData, 2);
  2354. end;
  2355. procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2356. begin
  2357. aPixel.Data.b := PWord(aData)^;
  2358. inc(aData, 2);
  2359. aPixel.Data.g := PWord(aData)^;
  2360. inc(aData, 2);
  2361. aPixel.Data.r := PWord(aData)^;
  2362. inc(aData, 2);
  2363. aPixel.Data.a := 0;
  2364. end;
  2365. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2366. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2367. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2368. procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2369. begin
  2370. inherited Map(aPixel, aData, aMapData);
  2371. PWord(aData)^ := aPixel.Data.a;
  2372. inc(aData, 2);
  2373. end;
  2374. procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2375. begin
  2376. inherited Unmap(aData, aPixel, aMapData);
  2377. aPixel.Data.a := PWord(aData)^;
  2378. inc(aData, 2);
  2379. end;
  2380. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2381. //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2382. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2383. procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2384. begin
  2385. PWord(aData)^ := aPixel.Data.a;
  2386. inc(aData, 2);
  2387. inherited Map(aPixel, aData, aMapData);
  2388. end;
  2389. procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2390. begin
  2391. aPixel.Data.a := PWord(aData)^;
  2392. inc(aData, 2);
  2393. inherited Unmap(aData, aPixel, aMapData);
  2394. end;
  2395. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2396. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2397. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2398. procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2399. begin
  2400. inherited Map(aPixel, aData, aMapData);
  2401. PWord(aData)^ := aPixel.Data.a;
  2402. inc(aData, 2);
  2403. end;
  2404. procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2405. begin
  2406. inherited Unmap(aData, aPixel, aMapData);
  2407. aPixel.Data.a := PWord(aData)^;
  2408. inc(aData, 2);
  2409. end;
  2410. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2411. //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2412. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2413. procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2414. begin
  2415. PWord(aData)^ := aPixel.Data.a;
  2416. inc(aData, 2);
  2417. inherited Map(aPixel, aData, aMapData);
  2418. end;
  2419. procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2420. begin
  2421. aPixel.Data.a := PWord(aData)^;
  2422. inc(aData, 2);
  2423. inherited Unmap(aData, aPixel, aMapData);
  2424. end;
  2425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2426. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2427. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2428. procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2429. var
  2430. i: Integer;
  2431. begin
  2432. PCardinal(aData)^ := 0;
  2433. for i := 0 to 3 do
  2434. if (Range.arr[i] > 0) then
  2435. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2436. inc(aData, 4);
  2437. end;
  2438. procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2439. var
  2440. i: Integer;
  2441. begin
  2442. for i := 0 to 3 do
  2443. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2444. inc(aData, 2);
  2445. end;
  2446. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2447. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2449. procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2450. begin
  2451. PCardinal(aData)^ := DepthWeight(aPixel);
  2452. inc(aData, 4);
  2453. end;
  2454. procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2455. begin
  2456. aPixel.Data.r := PCardinal(aData)^;
  2457. aPixel.Data.g := PCardinal(aData)^;
  2458. aPixel.Data.b := PCardinal(aData)^;
  2459. aPixel.Data.a := PCardinal(aData)^;
  2460. inc(aData, 4);
  2461. end;
  2462. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2464. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2465. procedure TfdAlpha4ub1.SetValues;
  2466. begin
  2467. inherited SetValues;
  2468. fBitsPerPixel := 8;
  2469. fFormat := tfAlpha4ub1;
  2470. fWithAlpha := tfAlpha4ub1;
  2471. fOpenGLFormat := tfAlpha4ub1;
  2472. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2473. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2474. fglFormat := GL_ALPHA;
  2475. fglInternalFormat := GL_ALPHA4;
  2476. fglDataFormat := GL_UNSIGNED_BYTE;
  2477. end;
  2478. procedure TfdAlpha8ub1.SetValues;
  2479. begin
  2480. inherited SetValues;
  2481. fBitsPerPixel := 8;
  2482. fFormat := tfAlpha8ub1;
  2483. fWithAlpha := tfAlpha8ub1;
  2484. fOpenGLFormat := tfAlpha8ub1;
  2485. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2486. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2487. fglFormat := GL_ALPHA;
  2488. fglInternalFormat := GL_ALPHA8;
  2489. fglDataFormat := GL_UNSIGNED_BYTE;
  2490. end;
  2491. procedure TfdAlpha16us1.SetValues;
  2492. begin
  2493. inherited SetValues;
  2494. fBitsPerPixel := 16;
  2495. fFormat := tfAlpha16us1;
  2496. fWithAlpha := tfAlpha16us1;
  2497. fOpenGLFormat := tfAlpha16us1;
  2498. fPrecision := glBitmapRec4ub(0, 0, 0, 16);
  2499. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2500. fglFormat := GL_ALPHA;
  2501. fglInternalFormat := GL_ALPHA16;
  2502. fglDataFormat := GL_UNSIGNED_SHORT;
  2503. end;
  2504. procedure TfdLuminance4ub1.SetValues;
  2505. begin
  2506. inherited SetValues;
  2507. fBitsPerPixel := 8;
  2508. fFormat := tfLuminance4ub1;
  2509. fWithAlpha := tfLuminance4Alpha4ub2;
  2510. fWithoutAlpha := tfLuminance4ub1;
  2511. fOpenGLFormat := tfLuminance4ub1;
  2512. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2513. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2514. fglFormat := GL_LUMINANCE;
  2515. fglInternalFormat := GL_LUMINANCE4;
  2516. fglDataFormat := GL_UNSIGNED_BYTE;
  2517. end;
  2518. procedure TfdLuminance8ub1.SetValues;
  2519. begin
  2520. inherited SetValues;
  2521. fBitsPerPixel := 8;
  2522. fFormat := tfLuminance8ub1;
  2523. fWithAlpha := tfLuminance8Alpha8ub2;
  2524. fWithoutAlpha := tfLuminance8ub1;
  2525. fOpenGLFormat := tfLuminance8ub1;
  2526. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2527. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2528. fglFormat := GL_LUMINANCE;
  2529. fglInternalFormat := GL_LUMINANCE8;
  2530. fglDataFormat := GL_UNSIGNED_BYTE;
  2531. end;
  2532. procedure TfdLuminance16us1.SetValues;
  2533. begin
  2534. inherited SetValues;
  2535. fBitsPerPixel := 16;
  2536. fFormat := tfLuminance16us1;
  2537. fWithAlpha := tfLuminance16Alpha16us2;
  2538. fWithoutAlpha := tfLuminance16us1;
  2539. fOpenGLFormat := tfLuminance16us1;
  2540. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2541. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  2542. fglFormat := GL_LUMINANCE;
  2543. fglInternalFormat := GL_LUMINANCE16;
  2544. fglDataFormat := GL_UNSIGNED_SHORT;
  2545. end;
  2546. procedure TfdLuminance4Alpha4ub2.SetValues;
  2547. begin
  2548. inherited SetValues;
  2549. fBitsPerPixel := 16;
  2550. fFormat := tfLuminance4Alpha4ub2;
  2551. fWithAlpha := tfLuminance4Alpha4ub2;
  2552. fWithoutAlpha := tfLuminance4ub1;
  2553. fOpenGLFormat := tfLuminance4Alpha4ub2;
  2554. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2555. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2556. fglFormat := GL_LUMINANCE_ALPHA;
  2557. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2558. fglDataFormat := GL_UNSIGNED_BYTE;
  2559. end;
  2560. procedure TfdLuminance6Alpha2ub2.SetValues;
  2561. begin
  2562. inherited SetValues;
  2563. fBitsPerPixel := 16;
  2564. fFormat := tfLuminance6Alpha2ub2;
  2565. fWithAlpha := tfLuminance6Alpha2ub2;
  2566. fWithoutAlpha := tfLuminance8ub1;
  2567. fOpenGLFormat := tfLuminance6Alpha2ub2;
  2568. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2569. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2570. fglFormat := GL_LUMINANCE_ALPHA;
  2571. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2572. fglDataFormat := GL_UNSIGNED_BYTE;
  2573. end;
  2574. procedure TfdLuminance8Alpha8ub2.SetValues;
  2575. begin
  2576. inherited SetValues;
  2577. fBitsPerPixel := 16;
  2578. fFormat := tfLuminance8Alpha8ub2;
  2579. fWithAlpha := tfLuminance8Alpha8ub2;
  2580. fWithoutAlpha := tfLuminance8ub1;
  2581. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2582. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2583. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2584. fglFormat := GL_LUMINANCE_ALPHA;
  2585. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2586. fglDataFormat := GL_UNSIGNED_BYTE;
  2587. end;
  2588. procedure TfdLuminance12Alpha4us2.SetValues;
  2589. begin
  2590. inherited SetValues;
  2591. fBitsPerPixel := 32;
  2592. fFormat := tfLuminance12Alpha4us2;
  2593. fWithAlpha := tfLuminance12Alpha4us2;
  2594. fWithoutAlpha := tfLuminance16us1;
  2595. fOpenGLFormat := tfLuminance12Alpha4us2;
  2596. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2597. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2598. fglFormat := GL_LUMINANCE_ALPHA;
  2599. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2600. fglDataFormat := GL_UNSIGNED_SHORT;
  2601. end;
  2602. procedure TfdLuminance16Alpha16us2.SetValues;
  2603. begin
  2604. inherited SetValues;
  2605. fBitsPerPixel := 32;
  2606. fFormat := tfLuminance16Alpha16us2;
  2607. fWithAlpha := tfLuminance16Alpha16us2;
  2608. fWithoutAlpha := tfLuminance16us1;
  2609. fOpenGLFormat := tfLuminance16Alpha16us2;
  2610. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2611. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2612. fglFormat := GL_LUMINANCE_ALPHA;
  2613. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2614. fglDataFormat := GL_UNSIGNED_SHORT;
  2615. end;
  2616. procedure TfdR3G3B2ub1.SetValues;
  2617. begin
  2618. inherited SetValues;
  2619. fBitsPerPixel := 8;
  2620. fFormat := tfR3G3B2ub1;
  2621. fWithAlpha := tfRGBA4us1;
  2622. fWithoutAlpha := tfR3G3B2ub1;
  2623. fOpenGLFormat := tfR3G3B2ub1;
  2624. fRGBInverted := tfEmpty;
  2625. fPrecision := glBitmapRec4ub(3, 3, 2, 0);
  2626. fShift := glBitmapRec4ub(5, 2, 0, 0);
  2627. fglFormat := GL_RGB;
  2628. fglInternalFormat := GL_R3_G3_B2;
  2629. fglDataFormat := GL_UNSIGNED_BYTE_3_3_2;
  2630. end;
  2631. procedure TfdRGBX4us1.SetValues;
  2632. begin
  2633. inherited SetValues;
  2634. fBitsPerPixel := 16;
  2635. fFormat := tfRGBX4us1;
  2636. fWithAlpha := tfRGBA4us1;
  2637. fWithoutAlpha := tfRGBX4us1;
  2638. fOpenGLFormat := tfRGBX4us1;
  2639. fRGBInverted := tfBGRX4us1;
  2640. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2641. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2642. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2643. fglInternalFormat := GL_RGB4;
  2644. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2645. end;
  2646. procedure TfdXRGB4us1.SetValues;
  2647. begin
  2648. inherited SetValues;
  2649. fBitsPerPixel := 16;
  2650. fFormat := tfXRGB4us1;
  2651. fWithAlpha := tfARGB4us1;
  2652. fWithoutAlpha := tfXRGB4us1;
  2653. fOpenGLFormat := tfXRGB4us1;
  2654. fRGBInverted := tfXBGR4us1;
  2655. fPrecision := glBitmapRec4ub(4, 4, 4, 0);
  2656. fShift := glBitmapRec4ub(8, 4, 0, 0);
  2657. fglFormat := GL_BGRA;
  2658. fglInternalFormat := GL_RGB4;
  2659. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2660. end;
  2661. procedure TfdR5G6B5us1.SetValues;
  2662. begin
  2663. inherited SetValues;
  2664. fBitsPerPixel := 16;
  2665. fFormat := tfR5G6B5us1;
  2666. fWithAlpha := tfRGB5A1us1;
  2667. fWithoutAlpha := tfR5G6B5us1;
  2668. fOpenGLFormat := tfR5G6B5us1;
  2669. fRGBInverted := tfB5G6R5us1;
  2670. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2671. fShift := glBitmapRec4ub(11, 5, 0, 0);
  2672. fglFormat := GL_RGB;
  2673. fglInternalFormat := GL_RGB565;
  2674. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2675. end;
  2676. procedure TfdRGB5X1us1.SetValues;
  2677. begin
  2678. inherited SetValues;
  2679. fBitsPerPixel := 16;
  2680. fFormat := tfRGB5X1us1;
  2681. fWithAlpha := tfRGB5A1us1;
  2682. fWithoutAlpha := tfRGB5X1us1;
  2683. fOpenGLFormat := tfRGB5X1us1;
  2684. fRGBInverted := tfBGR5X1us1;
  2685. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2686. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2687. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2688. fglInternalFormat := GL_RGB5;
  2689. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2690. end;
  2691. procedure TfdX1RGB5us1.SetValues;
  2692. begin
  2693. inherited SetValues;
  2694. fBitsPerPixel := 16;
  2695. fFormat := tfX1RGB5us1;
  2696. fWithAlpha := tfA1RGB5us1;
  2697. fWithoutAlpha := tfX1RGB5us1;
  2698. fOpenGLFormat := tfX1RGB5us1;
  2699. fRGBInverted := tfX1BGR5us1;
  2700. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2701. fShift := glBitmapRec4ub(10, 5, 0, 0);
  2702. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2703. fglInternalFormat := GL_RGB5;
  2704. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2705. end;
  2706. procedure TfdRGB8ub3.SetValues;
  2707. begin
  2708. inherited SetValues;
  2709. fBitsPerPixel := 24;
  2710. fFormat := tfRGB8ub3;
  2711. fWithAlpha := tfRGBA8ub4;
  2712. fWithoutAlpha := tfRGB8ub3;
  2713. fOpenGLFormat := tfRGB8ub3;
  2714. fRGBInverted := tfBGR8ub3;
  2715. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2716. fShift := glBitmapRec4ub(0, 8, 16, 0);
  2717. fglFormat := GL_RGB;
  2718. fglInternalFormat := GL_RGB8;
  2719. fglDataFormat := GL_UNSIGNED_BYTE;
  2720. end;
  2721. procedure TfdRGBX8ui1.SetValues;
  2722. begin
  2723. inherited SetValues;
  2724. fBitsPerPixel := 32;
  2725. fFormat := tfRGBX8ui1;
  2726. fWithAlpha := tfRGBA8ui1;
  2727. fWithoutAlpha := tfRGBX8ui1;
  2728. fOpenGLFormat := tfRGB8ub3;
  2729. fRGBInverted := tfBGRX8ui1;
  2730. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2731. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2732. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2733. fglInternalFormat := GL_RGB8;
  2734. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2735. end;
  2736. procedure TfdXRGB8ui1.SetValues;
  2737. begin
  2738. inherited SetValues;
  2739. fBitsPerPixel := 32;
  2740. fFormat := tfXRGB8ui1;
  2741. fWithAlpha := tfXRGB8ui1;
  2742. fWithoutAlpha := tfXRGB8ui1;
  2743. fOpenGLFormat := tfRGB8ub3;
  2744. fRGBInverted := tfXBGR8ui1;
  2745. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2746. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2747. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2748. fglInternalFormat := GL_RGB8;
  2749. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2750. end;
  2751. procedure TfdRGB10X2ui1.SetValues;
  2752. begin
  2753. inherited SetValues;
  2754. fBitsPerPixel := 32;
  2755. fFormat := tfRGB10X2ui1;
  2756. fWithAlpha := tfRGB10A2ui1;
  2757. fWithoutAlpha := tfRGB10X2ui1;
  2758. fOpenGLFormat := tfRGB10X2ui1;
  2759. fRGBInverted := tfBGR10X2ui1;
  2760. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2761. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2762. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2763. fglInternalFormat := GL_RGB10;
  2764. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2765. end;
  2766. procedure TfdX2RGB10ui1.SetValues;
  2767. begin
  2768. inherited SetValues;
  2769. fBitsPerPixel := 32;
  2770. fFormat := tfX2RGB10ui1;
  2771. fWithAlpha := tfA2RGB10ui1;
  2772. fWithoutAlpha := tfX2RGB10ui1;
  2773. fOpenGLFormat := tfX2RGB10ui1;
  2774. fRGBInverted := tfX2BGR10ui1;
  2775. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2776. fShift := glBitmapRec4ub(20, 10, 0, 0);
  2777. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2778. fglInternalFormat := GL_RGB10;
  2779. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2780. end;
  2781. procedure TfdRGB16us3.SetValues;
  2782. begin
  2783. inherited SetValues;
  2784. fBitsPerPixel := 48;
  2785. fFormat := tfRGB16us3;
  2786. fWithAlpha := tfRGBA16us4;
  2787. fWithoutAlpha := tfRGB16us3;
  2788. fOpenGLFormat := tfRGB16us3;
  2789. fRGBInverted := tfBGR16us3;
  2790. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2791. fShift := glBitmapRec4ub( 0, 16, 32, 0);
  2792. fglFormat := GL_RGB;
  2793. fglInternalFormat := GL_RGB16;
  2794. fglDataFormat := GL_UNSIGNED_SHORT;
  2795. end;
  2796. procedure TfdRGBA4us1.SetValues;
  2797. begin
  2798. inherited SetValues;
  2799. fBitsPerPixel := 16;
  2800. fFormat := tfRGBA4us1;
  2801. fWithAlpha := tfRGBA4us1;
  2802. fWithoutAlpha := tfRGBX4us1;
  2803. fOpenGLFormat := tfRGBA4us1;
  2804. fRGBInverted := tfBGRA4us1;
  2805. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2806. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2807. fglFormat := GL_RGBA;
  2808. fglInternalFormat := GL_RGBA4;
  2809. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2810. end;
  2811. procedure TfdARGB4us1.SetValues;
  2812. begin
  2813. inherited SetValues;
  2814. fBitsPerPixel := 16;
  2815. fFormat := tfARGB4us1;
  2816. fWithAlpha := tfARGB4us1;
  2817. fWithoutAlpha := tfXRGB4us1;
  2818. fOpenGLFormat := tfARGB4us1;
  2819. fRGBInverted := tfABGR4us1;
  2820. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2821. fShift := glBitmapRec4ub( 8, 4, 0, 12);
  2822. fglFormat := GL_BGRA;
  2823. fglInternalFormat := GL_RGBA4;
  2824. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2825. end;
  2826. procedure TfdRGB5A1us1.SetValues;
  2827. begin
  2828. inherited SetValues;
  2829. fBitsPerPixel := 16;
  2830. fFormat := tfRGB5A1us1;
  2831. fWithAlpha := tfRGB5A1us1;
  2832. fWithoutAlpha := tfRGB5X1us1;
  2833. fOpenGLFormat := tfRGB5A1us1;
  2834. fRGBInverted := tfBGR5A1us1;
  2835. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2836. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2837. fglFormat := GL_RGBA;
  2838. fglInternalFormat := GL_RGB5_A1;
  2839. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2840. end;
  2841. procedure TfdA1RGB5us1.SetValues;
  2842. begin
  2843. inherited SetValues;
  2844. fBitsPerPixel := 16;
  2845. fFormat := tfA1RGB5us1;
  2846. fWithAlpha := tfA1RGB5us1;
  2847. fWithoutAlpha := tfX1RGB5us1;
  2848. fOpenGLFormat := tfA1RGB5us1;
  2849. fRGBInverted := tfA1BGR5us1;
  2850. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2851. fShift := glBitmapRec4ub(10, 5, 0, 15);
  2852. fglFormat := GL_BGRA;
  2853. fglInternalFormat := GL_RGB5_A1;
  2854. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2855. end;
  2856. procedure TfdRGBA8ui1.SetValues;
  2857. begin
  2858. inherited SetValues;
  2859. fBitsPerPixel := 32;
  2860. fFormat := tfRGBA8ui1;
  2861. fWithAlpha := tfRGBA8ui1;
  2862. fWithoutAlpha := tfRGBX8ui1;
  2863. fOpenGLFormat := tfRGBA8ui1;
  2864. fRGBInverted := tfBGRA8ui1;
  2865. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2866. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2867. fglFormat := GL_RGBA;
  2868. fglInternalFormat := GL_RGBA8;
  2869. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2870. end;
  2871. procedure TfdARGB8ui1.SetValues;
  2872. begin
  2873. inherited SetValues;
  2874. fBitsPerPixel := 32;
  2875. fFormat := tfARGB8ui1;
  2876. fWithAlpha := tfARGB8ui1;
  2877. fWithoutAlpha := tfXRGB8ui1;
  2878. fOpenGLFormat := tfARGB8ui1;
  2879. fRGBInverted := tfABGR8ui1;
  2880. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2881. fShift := glBitmapRec4ub(16, 8, 0, 24);
  2882. fglFormat := GL_BGRA;
  2883. fglInternalFormat := GL_RGBA8;
  2884. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2885. end;
  2886. procedure TfdRGBA8ub4.SetValues;
  2887. begin
  2888. inherited SetValues;
  2889. fBitsPerPixel := 32;
  2890. fFormat := tfRGBA8ub4;
  2891. fWithAlpha := tfRGBA8ub4;
  2892. fWithoutAlpha := tfRGB8ub3;
  2893. fOpenGLFormat := tfRGBA8ub4;
  2894. fRGBInverted := tfBGRA8ub4;
  2895. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2896. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  2897. fglFormat := GL_RGBA;
  2898. fglInternalFormat := GL_RGBA8;
  2899. fglDataFormat := GL_UNSIGNED_BYTE;
  2900. end;
  2901. procedure TfdRGB10A2ui1.SetValues;
  2902. begin
  2903. inherited SetValues;
  2904. fBitsPerPixel := 32;
  2905. fFormat := tfRGB10A2ui1;
  2906. fWithAlpha := tfRGB10A2ui1;
  2907. fWithoutAlpha := tfRGB10X2ui1;
  2908. fOpenGLFormat := tfRGB10A2ui1;
  2909. fRGBInverted := tfBGR10A2ui1;
  2910. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2911. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2912. fglFormat := GL_RGBA;
  2913. fglInternalFormat := GL_RGB10_A2;
  2914. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2915. end;
  2916. procedure TfdA2RGB10ui1.SetValues;
  2917. begin
  2918. inherited SetValues;
  2919. fBitsPerPixel := 32;
  2920. fFormat := tfA2RGB10ui1;
  2921. fWithAlpha := tfA2RGB10ui1;
  2922. fWithoutAlpha := tfX2RGB10ui1;
  2923. fOpenGLFormat := tfA2RGB10ui1;
  2924. fRGBInverted := tfA2BGR10ui1;
  2925. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2926. fShift := glBitmapRec4ub(20, 10, 0, 30);
  2927. fglFormat := GL_BGRA;
  2928. fglInternalFormat := GL_RGB10_A2;
  2929. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2930. end;
  2931. procedure TfdRGBA16us4.SetValues;
  2932. begin
  2933. inherited SetValues;
  2934. fBitsPerPixel := 64;
  2935. fFormat := tfRGBA16us4;
  2936. fWithAlpha := tfRGBA16us4;
  2937. fWithoutAlpha := tfRGB16us3;
  2938. fOpenGLFormat := tfRGBA16us4;
  2939. fRGBInverted := tfBGRA16us4;
  2940. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2941. fShift := glBitmapRec4ub( 0, 16, 32, 48);
  2942. fglFormat := GL_RGBA;
  2943. fglInternalFormat := GL_RGBA16;
  2944. fglDataFormat := GL_UNSIGNED_SHORT;
  2945. end;
  2946. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2947. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2948. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2949. procedure TfdBGRX4us1.SetValues;
  2950. begin
  2951. inherited SetValues;
  2952. fBitsPerPixel := 16;
  2953. fFormat := tfBGRX4us1;
  2954. fWithAlpha := tfBGRA4us1;
  2955. fWithoutAlpha := tfBGRX4us1;
  2956. fOpenGLFormat := tfBGRX4us1;
  2957. fRGBInverted := tfRGBX4us1;
  2958. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2959. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  2960. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2961. fglInternalFormat := GL_RGB4;
  2962. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2963. end;
  2964. procedure TfdXBGR4us1.SetValues;
  2965. begin
  2966. inherited SetValues;
  2967. fBitsPerPixel := 16;
  2968. fFormat := tfXBGR4us1;
  2969. fWithAlpha := tfABGR4us1;
  2970. fWithoutAlpha := tfXBGR4us1;
  2971. fOpenGLFormat := tfXBGR4us1;
  2972. fRGBInverted := tfXRGB4us1;
  2973. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2974. fShift := glBitmapRec4ub( 0, 4, 8, 0);
  2975. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2976. fglInternalFormat := GL_RGB4;
  2977. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2978. end;
  2979. procedure TfdB5G6R5us1.SetValues;
  2980. begin
  2981. inherited SetValues;
  2982. fBitsPerPixel := 16;
  2983. fFormat := tfB5G6R5us1;
  2984. fWithAlpha := tfBGR5A1us1;
  2985. fWithoutAlpha := tfB5G6R5us1;
  2986. fOpenGLFormat := tfB5G6R5us1;
  2987. fRGBInverted := tfR5G6B5us1;
  2988. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2989. fShift := glBitmapRec4ub( 0, 5, 11, 0);
  2990. fglFormat := GL_RGB;
  2991. fglInternalFormat := GL_RGB565;
  2992. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2993. end;
  2994. procedure TfdBGR5X1us1.SetValues;
  2995. begin
  2996. inherited SetValues;
  2997. fBitsPerPixel := 16;
  2998. fFormat := tfBGR5X1us1;
  2999. fWithAlpha := tfBGR5A1us1;
  3000. fWithoutAlpha := tfBGR5X1us1;
  3001. fOpenGLFormat := tfBGR5X1us1;
  3002. fRGBInverted := tfRGB5X1us1;
  3003. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  3004. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  3005. fglFormat := GL_BGRA;
  3006. fglInternalFormat := GL_RGB5;
  3007. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3008. end;
  3009. procedure TfdX1BGR5us1.SetValues;
  3010. begin
  3011. inherited SetValues;
  3012. fBitsPerPixel := 16;
  3013. fFormat := tfX1BGR5us1;
  3014. fWithAlpha := tfA1BGR5us1;
  3015. fWithoutAlpha := tfX1BGR5us1;
  3016. fOpenGLFormat := tfX1BGR5us1;
  3017. fRGBInverted := tfX1RGB5us1;
  3018. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  3019. fShift := glBitmapRec4ub( 0, 5, 10, 0);
  3020. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3021. fglInternalFormat := GL_RGB5;
  3022. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3023. end;
  3024. procedure TfdBGR8ub3.SetValues;
  3025. begin
  3026. inherited SetValues;
  3027. fBitsPerPixel := 24;
  3028. fFormat := tfBGR8ub3;
  3029. fWithAlpha := tfBGRA8ub4;
  3030. fWithoutAlpha := tfBGR8ub3;
  3031. fOpenGLFormat := tfBGR8ub3;
  3032. fRGBInverted := tfRGB8ub3;
  3033. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  3034. fShift := glBitmapRec4ub(16, 8, 0, 0);
  3035. fglFormat := GL_BGR;
  3036. fglInternalFormat := GL_RGB8;
  3037. fglDataFormat := GL_UNSIGNED_BYTE;
  3038. end;
  3039. procedure TfdBGRX8ui1.SetValues;
  3040. begin
  3041. inherited SetValues;
  3042. fBitsPerPixel := 32;
  3043. fFormat := tfBGRX8ui1;
  3044. fWithAlpha := tfBGRA8ui1;
  3045. fWithoutAlpha := tfBGRX8ui1;
  3046. fOpenGLFormat := tfBGRX8ui1;
  3047. fRGBInverted := tfRGBX8ui1;
  3048. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  3049. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  3050. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3051. fglInternalFormat := GL_RGB8;
  3052. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3053. end;
  3054. procedure TfdXBGR8ui1.SetValues;
  3055. begin
  3056. inherited SetValues;
  3057. fBitsPerPixel := 32;
  3058. fFormat := tfXBGR8ui1;
  3059. fWithAlpha := tfABGR8ui1;
  3060. fWithoutAlpha := tfXBGR8ui1;
  3061. fOpenGLFormat := tfXBGR8ui1;
  3062. fRGBInverted := tfXRGB8ui1;
  3063. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  3064. fShift := glBitmapRec4ub( 0, 8, 16, 0);
  3065. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3066. fglInternalFormat := GL_RGB8;
  3067. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3068. end;
  3069. procedure TfdBGR10X2ui1.SetValues;
  3070. begin
  3071. inherited SetValues;
  3072. fBitsPerPixel := 32;
  3073. fFormat := tfBGR10X2ui1;
  3074. fWithAlpha := tfBGR10A2ui1;
  3075. fWithoutAlpha := tfBGR10X2ui1;
  3076. fOpenGLFormat := tfBGR10X2ui1;
  3077. fRGBInverted := tfRGB10X2ui1;
  3078. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  3079. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  3080. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3081. fglInternalFormat := GL_RGB10;
  3082. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3083. end;
  3084. procedure TfdX2BGR10ui1.SetValues;
  3085. begin
  3086. inherited SetValues;
  3087. fBitsPerPixel := 32;
  3088. fFormat := tfX2BGR10ui1;
  3089. fWithAlpha := tfA2BGR10ui1;
  3090. fWithoutAlpha := tfX2BGR10ui1;
  3091. fOpenGLFormat := tfX2BGR10ui1;
  3092. fRGBInverted := tfX2RGB10ui1;
  3093. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  3094. fShift := glBitmapRec4ub( 0, 10, 20, 0);
  3095. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3096. fglInternalFormat := GL_RGB10;
  3097. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3098. end;
  3099. procedure TfdBGR16us3.SetValues;
  3100. begin
  3101. inherited SetValues;
  3102. fBitsPerPixel := 48;
  3103. fFormat := tfBGR16us3;
  3104. fWithAlpha := tfBGRA16us4;
  3105. fWithoutAlpha := tfBGR16us3;
  3106. fOpenGLFormat := tfBGR16us3;
  3107. fRGBInverted := tfRGB16us3;
  3108. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  3109. fShift := glBitmapRec4ub(32, 16, 0, 0);
  3110. fglFormat := GL_BGR;
  3111. fglInternalFormat := GL_RGB16;
  3112. fglDataFormat := GL_UNSIGNED_SHORT;
  3113. end;
  3114. procedure TfdBGRA4us1.SetValues;
  3115. begin
  3116. inherited SetValues;
  3117. fBitsPerPixel := 16;
  3118. fFormat := tfBGRA4us1;
  3119. fWithAlpha := tfBGRA4us1;
  3120. fWithoutAlpha := tfBGRX4us1;
  3121. fOpenGLFormat := tfBGRA4us1;
  3122. fRGBInverted := tfRGBA4us1;
  3123. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3124. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  3125. fglFormat := GL_BGRA;
  3126. fglInternalFormat := GL_RGBA4;
  3127. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3128. end;
  3129. procedure TfdABGR4us1.SetValues;
  3130. begin
  3131. inherited SetValues;
  3132. fBitsPerPixel := 16;
  3133. fFormat := tfABGR4us1;
  3134. fWithAlpha := tfABGR4us1;
  3135. fWithoutAlpha := tfXBGR4us1;
  3136. fOpenGLFormat := tfABGR4us1;
  3137. fRGBInverted := tfARGB4us1;
  3138. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3139. fShift := glBitmapRec4ub( 0, 4, 8, 12);
  3140. fglFormat := GL_RGBA;
  3141. fglInternalFormat := GL_RGBA4;
  3142. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3143. end;
  3144. procedure TfdBGR5A1us1.SetValues;
  3145. begin
  3146. inherited SetValues;
  3147. fBitsPerPixel := 16;
  3148. fFormat := tfBGR5A1us1;
  3149. fWithAlpha := tfBGR5A1us1;
  3150. fWithoutAlpha := tfBGR5X1us1;
  3151. fOpenGLFormat := tfBGR5A1us1;
  3152. fRGBInverted := tfRGB5A1us1;
  3153. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3154. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  3155. fglFormat := GL_BGRA;
  3156. fglInternalFormat := GL_RGB5_A1;
  3157. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3158. end;
  3159. procedure TfdA1BGR5us1.SetValues;
  3160. begin
  3161. inherited SetValues;
  3162. fBitsPerPixel := 16;
  3163. fFormat := tfA1BGR5us1;
  3164. fWithAlpha := tfA1BGR5us1;
  3165. fWithoutAlpha := tfX1BGR5us1;
  3166. fOpenGLFormat := tfA1BGR5us1;
  3167. fRGBInverted := tfA1RGB5us1;
  3168. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3169. fShift := glBitmapRec4ub( 0, 5, 10, 15);
  3170. fglFormat := GL_RGBA;
  3171. fglInternalFormat := GL_RGB5_A1;
  3172. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3173. end;
  3174. procedure TfdBGRA8ui1.SetValues;
  3175. begin
  3176. inherited SetValues;
  3177. fBitsPerPixel := 32;
  3178. fFormat := tfBGRA8ui1;
  3179. fWithAlpha := tfBGRA8ui1;
  3180. fWithoutAlpha := tfBGRX8ui1;
  3181. fOpenGLFormat := tfBGRA8ui1;
  3182. fRGBInverted := tfRGBA8ui1;
  3183. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3184. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  3185. fglFormat := GL_BGRA;
  3186. fglInternalFormat := GL_RGBA8;
  3187. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3188. end;
  3189. procedure TfdABGR8ui1.SetValues;
  3190. begin
  3191. inherited SetValues;
  3192. fBitsPerPixel := 32;
  3193. fFormat := tfABGR8ui1;
  3194. fWithAlpha := tfABGR8ui1;
  3195. fWithoutAlpha := tfXBGR8ui1;
  3196. fOpenGLFormat := tfABGR8ui1;
  3197. fRGBInverted := tfARGB8ui1;
  3198. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3199. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  3200. fglFormat := GL_RGBA;
  3201. fglInternalFormat := GL_RGBA8;
  3202. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3203. end;
  3204. procedure TfdBGRA8ub4.SetValues;
  3205. begin
  3206. inherited SetValues;
  3207. fBitsPerPixel := 32;
  3208. fFormat := tfBGRA8ub4;
  3209. fWithAlpha := tfBGRA8ub4;
  3210. fWithoutAlpha := tfBGR8ub3;
  3211. fOpenGLFormat := tfBGRA8ub4;
  3212. fRGBInverted := tfRGBA8ub4;
  3213. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3214. fShift := glBitmapRec4ub(16, 8, 0, 24);
  3215. fglFormat := GL_BGRA;
  3216. fglInternalFormat := GL_RGBA8;
  3217. fglDataFormat := GL_UNSIGNED_BYTE;
  3218. end;
  3219. procedure TfdBGR10A2ui1.SetValues;
  3220. begin
  3221. inherited SetValues;
  3222. fBitsPerPixel := 32;
  3223. fFormat := tfBGR10A2ui1;
  3224. fWithAlpha := tfBGR10A2ui1;
  3225. fWithoutAlpha := tfBGR10X2ui1;
  3226. fOpenGLFormat := tfBGR10A2ui1;
  3227. fRGBInverted := tfRGB10A2ui1;
  3228. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3229. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  3230. fglFormat := GL_BGRA;
  3231. fglInternalFormat := GL_RGB10_A2;
  3232. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3233. end;
  3234. procedure TfdA2BGR10ui1.SetValues;
  3235. begin
  3236. inherited SetValues;
  3237. fBitsPerPixel := 32;
  3238. fFormat := tfA2BGR10ui1;
  3239. fWithAlpha := tfA2BGR10ui1;
  3240. fWithoutAlpha := tfX2BGR10ui1;
  3241. fOpenGLFormat := tfA2BGR10ui1;
  3242. fRGBInverted := tfA2RGB10ui1;
  3243. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3244. fShift := glBitmapRec4ub( 0, 10, 20, 30);
  3245. fglFormat := GL_RGBA;
  3246. fglInternalFormat := GL_RGB10_A2;
  3247. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3248. end;
  3249. procedure TfdBGRA16us4.SetValues;
  3250. begin
  3251. inherited SetValues;
  3252. fBitsPerPixel := 64;
  3253. fFormat := tfBGRA16us4;
  3254. fWithAlpha := tfBGRA16us4;
  3255. fWithoutAlpha := tfBGR16us3;
  3256. fOpenGLFormat := tfBGRA16us4;
  3257. fRGBInverted := tfRGBA16us4;
  3258. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3259. fShift := glBitmapRec4ub(32, 16, 0, 48);
  3260. fglFormat := GL_BGRA;
  3261. fglInternalFormat := GL_RGBA16;
  3262. fglDataFormat := GL_UNSIGNED_SHORT;
  3263. end;
  3264. procedure TfdDepth16us1.SetValues;
  3265. begin
  3266. inherited SetValues;
  3267. fBitsPerPixel := 16;
  3268. fFormat := tfDepth16us1;
  3269. fWithoutAlpha := tfDepth16us1;
  3270. fOpenGLFormat := tfDepth16us1;
  3271. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3272. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3273. fglFormat := GL_DEPTH_COMPONENT;
  3274. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3275. fglDataFormat := GL_UNSIGNED_SHORT;
  3276. end;
  3277. procedure TfdDepth24ui1.SetValues;
  3278. begin
  3279. inherited SetValues;
  3280. fBitsPerPixel := 32;
  3281. fFormat := tfDepth24ui1;
  3282. fWithoutAlpha := tfDepth24ui1;
  3283. fOpenGLFormat := tfDepth24ui1;
  3284. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3285. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3286. fglFormat := GL_DEPTH_COMPONENT;
  3287. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3288. fglDataFormat := GL_UNSIGNED_INT;
  3289. end;
  3290. procedure TfdDepth32ui1.SetValues;
  3291. begin
  3292. inherited SetValues;
  3293. fBitsPerPixel := 32;
  3294. fFormat := tfDepth32ui1;
  3295. fWithoutAlpha := tfDepth32ui1;
  3296. fOpenGLFormat := tfDepth32ui1;
  3297. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3298. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3299. fglFormat := GL_DEPTH_COMPONENT;
  3300. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3301. fglDataFormat := GL_UNSIGNED_INT;
  3302. end;
  3303. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3304. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3305. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3306. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3307. begin
  3308. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3309. end;
  3310. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3311. begin
  3312. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3313. end;
  3314. procedure TfdS3tcDtx1RGBA.SetValues;
  3315. begin
  3316. inherited SetValues;
  3317. fFormat := tfS3tcDtx1RGBA;
  3318. fWithAlpha := tfS3tcDtx1RGBA;
  3319. fOpenGLFormat := tfS3tcDtx1RGBA;
  3320. fUncompressed := tfRGB5A1us1;
  3321. fBitsPerPixel := 4;
  3322. fIsCompressed := true;
  3323. fglFormat := GL_COMPRESSED_RGBA;
  3324. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3325. fglDataFormat := GL_UNSIGNED_BYTE;
  3326. end;
  3327. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3328. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3329. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3330. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3331. begin
  3332. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3333. end;
  3334. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3335. begin
  3336. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3337. end;
  3338. procedure TfdS3tcDtx3RGBA.SetValues;
  3339. begin
  3340. inherited SetValues;
  3341. fFormat := tfS3tcDtx3RGBA;
  3342. fWithAlpha := tfS3tcDtx3RGBA;
  3343. fOpenGLFormat := tfS3tcDtx3RGBA;
  3344. fUncompressed := tfRGBA8ub4;
  3345. fBitsPerPixel := 8;
  3346. fIsCompressed := true;
  3347. fglFormat := GL_COMPRESSED_RGBA;
  3348. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3349. fglDataFormat := GL_UNSIGNED_BYTE;
  3350. end;
  3351. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3352. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3353. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3354. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3355. begin
  3356. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3357. end;
  3358. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3359. begin
  3360. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3361. end;
  3362. procedure TfdS3tcDtx5RGBA.SetValues;
  3363. begin
  3364. inherited Create;
  3365. fFormat := tfS3tcDtx3RGBA;
  3366. fWithAlpha := tfS3tcDtx3RGBA;
  3367. fOpenGLFormat := tfS3tcDtx3RGBA;
  3368. fUncompressed := tfRGBA8ub4;
  3369. fBitsPerPixel := 8;
  3370. fIsCompressed := true;
  3371. fglFormat := GL_COMPRESSED_RGBA;
  3372. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3373. fglDataFormat := GL_UNSIGNED_BYTE;
  3374. end;
  3375. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3376. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3377. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3378. function TglBitmapFormatDescriptor.GetHasRed: Boolean;
  3379. begin
  3380. result := (fPrecision.r > 0);
  3381. end;
  3382. function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
  3383. begin
  3384. result := (fPrecision.g > 0);
  3385. end;
  3386. function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
  3387. begin
  3388. result := (fPrecision.b > 0);
  3389. end;
  3390. function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
  3391. begin
  3392. result := (fPrecision.a > 0);
  3393. end;
  3394. function TglBitmapFormatDescriptor.GetHasColor: Boolean;
  3395. begin
  3396. result := HasRed or HasGreen or HasBlue;
  3397. end;
  3398. function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
  3399. begin
  3400. result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
  3401. end;
  3402. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3403. procedure TglBitmapFormatDescriptor.SetValues;
  3404. begin
  3405. fFormat := tfEmpty;
  3406. fWithAlpha := tfEmpty;
  3407. fWithoutAlpha := tfEmpty;
  3408. fOpenGLFormat := tfEmpty;
  3409. fRGBInverted := tfEmpty;
  3410. fUncompressed := tfEmpty;
  3411. fBitsPerPixel := 0;
  3412. fIsCompressed := false;
  3413. fglFormat := 0;
  3414. fglInternalFormat := 0;
  3415. fglDataFormat := 0;
  3416. FillChar(fPrecision, 0, SizeOf(fPrecision));
  3417. FillChar(fShift, 0, SizeOf(fShift));
  3418. end;
  3419. procedure TglBitmapFormatDescriptor.CalcValues;
  3420. var
  3421. i: Integer;
  3422. begin
  3423. fBytesPerPixel := fBitsPerPixel / 8;
  3424. fChannelCount := 0;
  3425. for i := 0 to 3 do begin
  3426. if (fPrecision.arr[i] > 0) then
  3427. inc(fChannelCount);
  3428. fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
  3429. fMask.arr[i] := fRange.arr[i] shl fShift.arr[i];
  3430. end;
  3431. end;
  3432. constructor TglBitmapFormatDescriptor.Create;
  3433. begin
  3434. inherited Create;
  3435. SetValues;
  3436. CalcValues;
  3437. end;
  3438. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3439. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3440. var
  3441. f: TglBitmapFormat;
  3442. begin
  3443. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3444. result := TFormatDescriptor.Get(f);
  3445. if (result.glInternalFormat = aInternalFormat) then
  3446. exit;
  3447. end;
  3448. result := TFormatDescriptor.Get(tfEmpty);
  3449. end;
  3450. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3451. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3452. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3453. class procedure TFormatDescriptor.Init;
  3454. begin
  3455. if not Assigned(FormatDescriptorCS) then
  3456. FormatDescriptorCS := TCriticalSection.Create;
  3457. end;
  3458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3459. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3460. begin
  3461. FormatDescriptorCS.Enter;
  3462. try
  3463. result := FormatDescriptors[aFormat];
  3464. if not Assigned(result) then begin
  3465. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3466. FormatDescriptors[aFormat] := result;
  3467. end;
  3468. finally
  3469. FormatDescriptorCS.Leave;
  3470. end;
  3471. end;
  3472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3473. class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3474. begin
  3475. result := Get(Get(aFormat).WithAlpha);
  3476. end;
  3477. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3478. class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
  3479. var
  3480. ft: TglBitmapFormat;
  3481. begin
  3482. // find matching format with OpenGL support
  3483. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3484. result := Get(ft);
  3485. if (result.MaskMatch(aMask)) and
  3486. (result.glFormat <> 0) and
  3487. (result.glInternalFormat <> 0) and
  3488. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3489. then
  3490. exit;
  3491. end;
  3492. // find matching format without OpenGL Support
  3493. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3494. result := Get(ft);
  3495. if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3496. exit;
  3497. end;
  3498. result := FormatDescriptors[tfEmpty];
  3499. end;
  3500. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3501. class procedure TFormatDescriptor.Clear;
  3502. var
  3503. f: TglBitmapFormat;
  3504. begin
  3505. FormatDescriptorCS.Enter;
  3506. try
  3507. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3508. FreeAndNil(FormatDescriptors[f]);
  3509. finally
  3510. FormatDescriptorCS.Leave;
  3511. end;
  3512. end;
  3513. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3514. class procedure TFormatDescriptor.Finalize;
  3515. begin
  3516. Clear;
  3517. FreeAndNil(FormatDescriptorCS);
  3518. end;
  3519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3520. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3521. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3522. procedure TbmpBitfieldFormat.SetValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
  3523. var
  3524. i: Integer;
  3525. begin
  3526. for i := 0 to 3 do begin
  3527. fShift.arr[i] := 0;
  3528. while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin
  3529. aMask.arr[i] := aMask.arr[i] shr 1;
  3530. inc(fShift.arr[i]);
  3531. end;
  3532. fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
  3533. end;
  3534. CalcValues;
  3535. end;
  3536. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3537. procedure TbmpBitfieldFormat.SetValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3538. begin
  3539. fBitsPerPixel := aBBP;
  3540. fPrecision := aPrec;
  3541. fShift := aShift;
  3542. CalcValues;
  3543. end;
  3544. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3545. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3546. var
  3547. data: QWord;
  3548. begin
  3549. data :=
  3550. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3551. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3552. ((aPixel.Data.b and Range.b) shl Shift.b) or
  3553. ((aPixel.Data.a and Range.a) shl Shift.a);
  3554. case BitsPerPixel of
  3555. 8: aData^ := data;
  3556. 16: PWord(aData)^ := data;
  3557. 32: PCardinal(aData)^ := data;
  3558. 64: PQWord(aData)^ := data;
  3559. else
  3560. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3561. end;
  3562. inc(aData, Round(BytesPerPixel));
  3563. end;
  3564. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3565. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3566. var
  3567. data: QWord;
  3568. i: Integer;
  3569. begin
  3570. case BitsPerPixel of
  3571. 8: data := aData^;
  3572. 16: data := PWord(aData)^;
  3573. 32: data := PCardinal(aData)^;
  3574. 64: data := PQWord(aData)^;
  3575. else
  3576. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3577. end;
  3578. for i := 0 to 3 do
  3579. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
  3580. inc(aData, Round(BytesPerPixel));
  3581. end;
  3582. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3583. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3584. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3585. procedure TbmpColorTableFormat.SetValues;
  3586. begin
  3587. inherited SetValues;
  3588. fShift := glBitmapRec4ub(8, 8, 8, 0);
  3589. end;
  3590. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3591. procedure TbmpColorTableFormat.SetValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3592. begin
  3593. fFormat := aFormat;
  3594. fBitsPerPixel := aBPP;
  3595. fPrecision := aPrec;
  3596. fShift := aShift;
  3597. CalcValues;
  3598. end;
  3599. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3600. procedure TbmpColorTableFormat.CalcValues;
  3601. begin
  3602. inherited CalcValues;
  3603. end;
  3604. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3605. procedure TbmpColorTableFormat.CreateColorTable;
  3606. var
  3607. i: Integer;
  3608. begin
  3609. SetLength(fColorTable, 256);
  3610. if not HasColor then begin
  3611. // alpha
  3612. for i := 0 to High(fColorTable) do begin
  3613. fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3614. fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3615. fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3616. fColorTable[i].a := 0;
  3617. end;
  3618. end else begin
  3619. // normal
  3620. for i := 0 to High(fColorTable) do begin
  3621. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3622. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3623. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3624. fColorTable[i].a := 0;
  3625. end;
  3626. end;
  3627. end;
  3628. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3629. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3630. begin
  3631. if (BitsPerPixel <> 8) then
  3632. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3633. if not HasColor then
  3634. // alpha
  3635. aData^ := aPixel.Data.a
  3636. else
  3637. // normal
  3638. aData^ := Round(
  3639. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3640. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3641. ((aPixel.Data.b and Range.b) shl Shift.b));
  3642. inc(aData);
  3643. end;
  3644. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3645. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3646. begin
  3647. if (BitsPerPixel <> 8) then
  3648. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3649. with fColorTable[aData^] do begin
  3650. aPixel.Data.r := r;
  3651. aPixel.Data.g := g;
  3652. aPixel.Data.b := b;
  3653. aPixel.Data.a := a;
  3654. end;
  3655. inc(aData, 1);
  3656. end;
  3657. destructor TbmpColorTableFormat.Destroy;
  3658. begin
  3659. SetLength(fColorTable, 0);
  3660. inherited Destroy;
  3661. end;
  3662. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3663. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3664. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3665. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3666. var
  3667. i: Integer;
  3668. begin
  3669. for i := 0 to 3 do begin
  3670. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3671. if (aSourceFD.Range.arr[i] > 0) then
  3672. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3673. else
  3674. aPixel.Data.arr[i] := 0;
  3675. end;
  3676. end;
  3677. end;
  3678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3679. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3680. begin
  3681. with aFuncRec do begin
  3682. if (Source.Range.r > 0) then
  3683. Dest.Data.r := Source.Data.r;
  3684. if (Source.Range.g > 0) then
  3685. Dest.Data.g := Source.Data.g;
  3686. if (Source.Range.b > 0) then
  3687. Dest.Data.b := Source.Data.b;
  3688. if (Source.Range.a > 0) then
  3689. Dest.Data.a := Source.Data.a;
  3690. end;
  3691. end;
  3692. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3693. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3694. var
  3695. i: Integer;
  3696. begin
  3697. with aFuncRec do begin
  3698. for i := 0 to 3 do
  3699. if (Source.Range.arr[i] > 0) then
  3700. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3701. end;
  3702. end;
  3703. type
  3704. TShiftData = packed record
  3705. case Integer of
  3706. 0: (r, g, b, a: SmallInt);
  3707. 1: (arr: array[0..3] of SmallInt);
  3708. end;
  3709. PShiftData = ^TShiftData;
  3710. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3711. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3712. var
  3713. i: Integer;
  3714. begin
  3715. with aFuncRec do
  3716. for i := 0 to 3 do
  3717. if (Source.Range.arr[i] > 0) then
  3718. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3719. end;
  3720. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3721. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3722. begin
  3723. with aFuncRec do begin
  3724. Dest.Data := Source.Data;
  3725. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3726. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3727. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3728. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3729. end;
  3730. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3731. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3732. end;
  3733. end;
  3734. end;
  3735. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3736. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3737. var
  3738. i: Integer;
  3739. begin
  3740. with aFuncRec do begin
  3741. for i := 0 to 3 do
  3742. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3743. end;
  3744. end;
  3745. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3746. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3747. var
  3748. Temp: Single;
  3749. begin
  3750. with FuncRec do begin
  3751. if (FuncRec.Args = nil) then begin //source has no alpha
  3752. Temp :=
  3753. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3754. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3755. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3756. Dest.Data.a := Round(Dest.Range.a * Temp);
  3757. end else
  3758. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3759. end;
  3760. end;
  3761. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3762. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3763. type
  3764. PglBitmapPixelData = ^TglBitmapPixelData;
  3765. begin
  3766. with FuncRec do begin
  3767. Dest.Data.r := Source.Data.r;
  3768. Dest.Data.g := Source.Data.g;
  3769. Dest.Data.b := Source.Data.b;
  3770. with PglBitmapPixelData(Args)^ do
  3771. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3772. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3773. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3774. Dest.Data.a := 0
  3775. else
  3776. Dest.Data.a := Dest.Range.a;
  3777. end;
  3778. end;
  3779. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3780. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3781. begin
  3782. with FuncRec do begin
  3783. Dest.Data.r := Source.Data.r;
  3784. Dest.Data.g := Source.Data.g;
  3785. Dest.Data.b := Source.Data.b;
  3786. Dest.Data.a := PCardinal(Args)^;
  3787. end;
  3788. end;
  3789. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3790. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3791. type
  3792. PRGBPix = ^TRGBPix;
  3793. TRGBPix = array [0..2] of byte;
  3794. var
  3795. Temp: Byte;
  3796. begin
  3797. while aWidth > 0 do begin
  3798. Temp := PRGBPix(aData)^[0];
  3799. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3800. PRGBPix(aData)^[2] := Temp;
  3801. if aHasAlpha then
  3802. Inc(aData, 4)
  3803. else
  3804. Inc(aData, 3);
  3805. dec(aWidth);
  3806. end;
  3807. end;
  3808. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3809. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3810. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3811. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  3812. begin
  3813. result := TFormatDescriptor.Get(Format);
  3814. end;
  3815. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3816. function TglBitmap.GetWidth: Integer;
  3817. begin
  3818. if (ffX in fDimension.Fields) then
  3819. result := fDimension.X
  3820. else
  3821. result := -1;
  3822. end;
  3823. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3824. function TglBitmap.GetHeight: Integer;
  3825. begin
  3826. if (ffY in fDimension.Fields) then
  3827. result := fDimension.Y
  3828. else
  3829. result := -1;
  3830. end;
  3831. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3832. function TglBitmap.GetFileWidth: Integer;
  3833. begin
  3834. result := Max(1, Width);
  3835. end;
  3836. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3837. function TglBitmap.GetFileHeight: Integer;
  3838. begin
  3839. result := Max(1, Height);
  3840. end;
  3841. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3842. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3843. begin
  3844. if fCustomData = aValue then
  3845. exit;
  3846. fCustomData := aValue;
  3847. end;
  3848. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3849. procedure TglBitmap.SetCustomName(const aValue: String);
  3850. begin
  3851. if fCustomName = aValue then
  3852. exit;
  3853. fCustomName := aValue;
  3854. end;
  3855. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3856. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3857. begin
  3858. if fCustomNameW = aValue then
  3859. exit;
  3860. fCustomNameW := aValue;
  3861. end;
  3862. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3863. procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
  3864. begin
  3865. if fFreeDataOnDestroy = aValue then
  3866. exit;
  3867. fFreeDataOnDestroy := aValue;
  3868. end;
  3869. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3870. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3871. begin
  3872. if fDeleteTextureOnFree = aValue then
  3873. exit;
  3874. fDeleteTextureOnFree := aValue;
  3875. end;
  3876. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3877. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3878. begin
  3879. if fFormat = aValue then
  3880. exit;
  3881. if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
  3882. raise EglBitmapUnsupportedFormat.Create(Format);
  3883. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  3884. end;
  3885. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3886. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3887. begin
  3888. if fFreeDataAfterGenTexture = aValue then
  3889. exit;
  3890. fFreeDataAfterGenTexture := aValue;
  3891. end;
  3892. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3893. procedure TglBitmap.SetID(const aValue: Cardinal);
  3894. begin
  3895. if fID = aValue then
  3896. exit;
  3897. fID := aValue;
  3898. end;
  3899. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3900. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3901. begin
  3902. if fMipMap = aValue then
  3903. exit;
  3904. fMipMap := aValue;
  3905. end;
  3906. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3907. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3908. begin
  3909. if fTarget = aValue then
  3910. exit;
  3911. fTarget := aValue;
  3912. end;
  3913. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3914. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3915. var
  3916. MaxAnisotropic: Integer;
  3917. begin
  3918. fAnisotropic := aValue;
  3919. if (ID > 0) then begin
  3920. if GL_EXT_texture_filter_anisotropic then begin
  3921. if fAnisotropic > 0 then begin
  3922. Bind(false);
  3923. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3924. if aValue > MaxAnisotropic then
  3925. fAnisotropic := MaxAnisotropic;
  3926. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3927. end;
  3928. end else begin
  3929. fAnisotropic := 0;
  3930. end;
  3931. end;
  3932. end;
  3933. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3934. procedure TglBitmap.CreateID;
  3935. begin
  3936. if (ID <> 0) then
  3937. glDeleteTextures(1, @fID);
  3938. glGenTextures(1, @fID);
  3939. Bind(false);
  3940. end;
  3941. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3942. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3943. begin
  3944. // Set Up Parameters
  3945. SetWrap(fWrapS, fWrapT, fWrapR);
  3946. SetFilter(fFilterMin, fFilterMag);
  3947. SetAnisotropic(fAnisotropic);
  3948. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3949. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  3950. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3951. // Mip Maps Generation Mode
  3952. aBuildWithGlu := false;
  3953. if (MipMap = mmMipmap) then begin
  3954. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3955. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3956. else
  3957. aBuildWithGlu := true;
  3958. end else if (MipMap = mmMipmapGlu) then
  3959. aBuildWithGlu := true;
  3960. end;
  3961. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3962. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  3963. const aWidth: Integer; const aHeight: Integer);
  3964. var
  3965. s: Single;
  3966. begin
  3967. if (Data <> aData) then begin
  3968. if (Assigned(Data)) then
  3969. FreeMem(Data);
  3970. fData := aData;
  3971. end;
  3972. if not Assigned(fData) then begin
  3973. fPixelSize := 0;
  3974. fRowSize := 0;
  3975. end else begin
  3976. FillChar(fDimension, SizeOf(fDimension), 0);
  3977. if aWidth <> -1 then begin
  3978. fDimension.Fields := fDimension.Fields + [ffX];
  3979. fDimension.X := aWidth;
  3980. end;
  3981. if aHeight <> -1 then begin
  3982. fDimension.Fields := fDimension.Fields + [ffY];
  3983. fDimension.Y := aHeight;
  3984. end;
  3985. s := TFormatDescriptor.Get(aFormat).BytesPerPixel;
  3986. fFormat := aFormat;
  3987. fPixelSize := Ceil(s);
  3988. fRowSize := Ceil(s * aWidth);
  3989. end;
  3990. end;
  3991. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3992. function TglBitmap.FlipHorz: Boolean;
  3993. begin
  3994. result := false;
  3995. end;
  3996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3997. function TglBitmap.FlipVert: Boolean;
  3998. begin
  3999. result := false;
  4000. end;
  4001. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4002. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4003. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4004. procedure TglBitmap.AfterConstruction;
  4005. begin
  4006. inherited AfterConstruction;
  4007. fID := 0;
  4008. fTarget := 0;
  4009. fIsResident := false;
  4010. fMipMap := glBitmapDefaultMipmap;
  4011. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  4012. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  4013. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  4014. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  4015. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  4016. end;
  4017. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4018. procedure TglBitmap.BeforeDestruction;
  4019. var
  4020. NewData: PByte;
  4021. begin
  4022. if fFreeDataOnDestroy then begin
  4023. NewData := nil;
  4024. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  4025. end;
  4026. if (fID > 0) and fDeleteTextureOnFree then
  4027. glDeleteTextures(1, @fID);
  4028. inherited BeforeDestruction;
  4029. end;
  4030. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4031. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  4032. var
  4033. TempPos: Integer;
  4034. begin
  4035. if not Assigned(aResType) then begin
  4036. TempPos := Pos('.', aResource);
  4037. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  4038. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  4039. end;
  4040. end;
  4041. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4042. procedure TglBitmap.LoadFromFile(const aFilename: String);
  4043. var
  4044. fs: TFileStream;
  4045. begin
  4046. if not FileExists(aFilename) then
  4047. raise EglBitmap.Create('file does not exist: ' + aFilename);
  4048. fFilename := aFilename;
  4049. fs := TFileStream.Create(fFilename, fmOpenRead);
  4050. try
  4051. fs.Position := 0;
  4052. LoadFromStream(fs);
  4053. finally
  4054. fs.Free;
  4055. end;
  4056. end;
  4057. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4058. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  4059. begin
  4060. {$IFDEF GLB_SUPPORT_PNG_READ}
  4061. if not LoadPNG(aStream) then
  4062. {$ENDIF}
  4063. {$IFDEF GLB_SUPPORT_JPEG_READ}
  4064. if not LoadJPEG(aStream) then
  4065. {$ENDIF}
  4066. if not LoadDDS(aStream) then
  4067. if not LoadTGA(aStream) then
  4068. if not LoadBMP(aStream) then
  4069. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  4070. end;
  4071. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4072. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  4073. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  4074. var
  4075. tmpData: PByte;
  4076. size: Integer;
  4077. begin
  4078. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4079. GetMem(tmpData, size);
  4080. try
  4081. FillChar(tmpData^, size, #$FF);
  4082. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4083. except
  4084. if Assigned(tmpData) then
  4085. FreeMem(tmpData);
  4086. raise;
  4087. end;
  4088. AddFunc(Self, aFunc, false, aFormat, aArgs);
  4089. end;
  4090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4091. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  4092. var
  4093. rs: TResourceStream;
  4094. begin
  4095. PrepareResType(aResource, aResType);
  4096. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4097. try
  4098. LoadFromStream(rs);
  4099. finally
  4100. rs.Free;
  4101. end;
  4102. end;
  4103. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4104. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4105. var
  4106. rs: TResourceStream;
  4107. begin
  4108. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4109. try
  4110. LoadFromStream(rs);
  4111. finally
  4112. rs.Free;
  4113. end;
  4114. end;
  4115. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4116. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  4117. var
  4118. fs: TFileStream;
  4119. begin
  4120. fs := TFileStream.Create(aFileName, fmCreate);
  4121. try
  4122. fs.Position := 0;
  4123. SaveToStream(fs, aFileType);
  4124. finally
  4125. fs.Free;
  4126. end;
  4127. end;
  4128. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4129. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  4130. begin
  4131. case aFileType of
  4132. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4133. ftPNG: SavePNG(aStream);
  4134. {$ENDIF}
  4135. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  4136. ftJPEG: SaveJPEG(aStream);
  4137. {$ENDIF}
  4138. ftDDS: SaveDDS(aStream);
  4139. ftTGA: SaveTGA(aStream);
  4140. ftBMP: SaveBMP(aStream);
  4141. end;
  4142. end;
  4143. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4144. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  4145. begin
  4146. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  4147. end;
  4148. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4149. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  4150. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  4151. var
  4152. DestData, TmpData, SourceData: pByte;
  4153. TempHeight, TempWidth: Integer;
  4154. SourceFD, DestFD: TFormatDescriptor;
  4155. SourceMD, DestMD: Pointer;
  4156. FuncRec: TglBitmapFunctionRec;
  4157. begin
  4158. Assert(Assigned(Data));
  4159. Assert(Assigned(aSource));
  4160. Assert(Assigned(aSource.Data));
  4161. result := false;
  4162. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  4163. SourceFD := TFormatDescriptor.Get(aSource.Format);
  4164. DestFD := TFormatDescriptor.Get(aFormat);
  4165. if (SourceFD.IsCompressed) then
  4166. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  4167. if (DestFD.IsCompressed) then
  4168. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  4169. // inkompatible Formats so CreateTemp
  4170. if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
  4171. aCreateTemp := true;
  4172. // Values
  4173. TempHeight := Max(1, aSource.Height);
  4174. TempWidth := Max(1, aSource.Width);
  4175. FuncRec.Sender := Self;
  4176. FuncRec.Args := aArgs;
  4177. TmpData := nil;
  4178. if aCreateTemp then begin
  4179. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  4180. DestData := TmpData;
  4181. end else
  4182. DestData := Data;
  4183. try
  4184. SourceFD.PreparePixel(FuncRec.Source);
  4185. DestFD.PreparePixel (FuncRec.Dest);
  4186. SourceMD := SourceFD.CreateMappingData;
  4187. DestMD := DestFD.CreateMappingData;
  4188. FuncRec.Size := aSource.Dimension;
  4189. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4190. try
  4191. SourceData := aSource.Data;
  4192. FuncRec.Position.Y := 0;
  4193. while FuncRec.Position.Y < TempHeight do begin
  4194. FuncRec.Position.X := 0;
  4195. while FuncRec.Position.X < TempWidth do begin
  4196. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4197. aFunc(FuncRec);
  4198. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  4199. inc(FuncRec.Position.X);
  4200. end;
  4201. inc(FuncRec.Position.Y);
  4202. end;
  4203. // Updating Image or InternalFormat
  4204. if aCreateTemp then
  4205. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  4206. else if (aFormat <> fFormat) then
  4207. Format := aFormat;
  4208. result := true;
  4209. finally
  4210. SourceFD.FreeMappingData(SourceMD);
  4211. DestFD.FreeMappingData(DestMD);
  4212. end;
  4213. except
  4214. if aCreateTemp and Assigned(TmpData) then
  4215. FreeMem(TmpData);
  4216. raise;
  4217. end;
  4218. end;
  4219. end;
  4220. {$IFDEF GLB_SDL}
  4221. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4222. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  4223. var
  4224. Row, RowSize: Integer;
  4225. SourceData, TmpData: PByte;
  4226. TempDepth: Integer;
  4227. FormatDesc: TFormatDescriptor;
  4228. function GetRowPointer(Row: Integer): pByte;
  4229. begin
  4230. result := aSurface.pixels;
  4231. Inc(result, Row * RowSize);
  4232. end;
  4233. begin
  4234. result := false;
  4235. FormatDesc := TFormatDescriptor.Get(Format);
  4236. if FormatDesc.IsCompressed then
  4237. raise EglBitmapUnsupportedFormat.Create(Format);
  4238. if Assigned(Data) then begin
  4239. case Trunc(FormatDesc.PixelSize) of
  4240. 1: TempDepth := 8;
  4241. 2: TempDepth := 16;
  4242. 3: TempDepth := 24;
  4243. 4: TempDepth := 32;
  4244. else
  4245. raise EglBitmapUnsupportedFormat.Create(Format);
  4246. end;
  4247. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4248. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4249. SourceData := Data;
  4250. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4251. for Row := 0 to FileHeight-1 do begin
  4252. TmpData := GetRowPointer(Row);
  4253. if Assigned(TmpData) then begin
  4254. Move(SourceData^, TmpData^, RowSize);
  4255. inc(SourceData, RowSize);
  4256. end;
  4257. end;
  4258. result := true;
  4259. end;
  4260. end;
  4261. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4262. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4263. var
  4264. pSource, pData, pTempData: PByte;
  4265. Row, RowSize, TempWidth, TempHeight: Integer;
  4266. IntFormat: TglBitmapFormat;
  4267. fd: TFormatDescriptor;
  4268. Mask: TglBitmapMask;
  4269. function GetRowPointer(Row: Integer): pByte;
  4270. begin
  4271. result := aSurface^.pixels;
  4272. Inc(result, Row * RowSize);
  4273. end;
  4274. begin
  4275. result := false;
  4276. if (Assigned(aSurface)) then begin
  4277. with aSurface^.format^ do begin
  4278. Mask.r := RMask;
  4279. Mask.g := GMask;
  4280. Mask.b := BMask;
  4281. Mask.a := AMask;
  4282. IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
  4283. if (IntFormat = tfEmpty) then
  4284. raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
  4285. end;
  4286. fd := TFormatDescriptor.Get(IntFormat);
  4287. TempWidth := aSurface^.w;
  4288. TempHeight := aSurface^.h;
  4289. RowSize := fd.GetSize(TempWidth, 1);
  4290. GetMem(pData, TempHeight * RowSize);
  4291. try
  4292. pTempData := pData;
  4293. for Row := 0 to TempHeight -1 do begin
  4294. pSource := GetRowPointer(Row);
  4295. if (Assigned(pSource)) then begin
  4296. Move(pSource^, pTempData^, RowSize);
  4297. Inc(pTempData, RowSize);
  4298. end;
  4299. end;
  4300. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4301. result := true;
  4302. except
  4303. if Assigned(pData) then
  4304. FreeMem(pData);
  4305. raise;
  4306. end;
  4307. end;
  4308. end;
  4309. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4310. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4311. var
  4312. Row, Col, AlphaInterleave: Integer;
  4313. pSource, pDest: PByte;
  4314. function GetRowPointer(Row: Integer): pByte;
  4315. begin
  4316. result := aSurface.pixels;
  4317. Inc(result, Row * Width);
  4318. end;
  4319. begin
  4320. result := false;
  4321. if Assigned(Data) then begin
  4322. if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
  4323. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4324. AlphaInterleave := 0;
  4325. case Format of
  4326. tfLuminance8Alpha8ub2:
  4327. AlphaInterleave := 1;
  4328. tfBGRA8ub4, tfRGBA8ub4:
  4329. AlphaInterleave := 3;
  4330. end;
  4331. pSource := Data;
  4332. for Row := 0 to Height -1 do begin
  4333. pDest := GetRowPointer(Row);
  4334. if Assigned(pDest) then begin
  4335. for Col := 0 to Width -1 do begin
  4336. Inc(pSource, AlphaInterleave);
  4337. pDest^ := pSource^;
  4338. Inc(pDest);
  4339. Inc(pSource);
  4340. end;
  4341. end;
  4342. end;
  4343. result := true;
  4344. end;
  4345. end;
  4346. end;
  4347. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4348. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4349. var
  4350. bmp: TglBitmap2D;
  4351. begin
  4352. bmp := TglBitmap2D.Create;
  4353. try
  4354. bmp.AssignFromSurface(aSurface);
  4355. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4356. finally
  4357. bmp.Free;
  4358. end;
  4359. end;
  4360. {$ENDIF}
  4361. {$IFDEF GLB_DELPHI}
  4362. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4363. function CreateGrayPalette: HPALETTE;
  4364. var
  4365. Idx: Integer;
  4366. Pal: PLogPalette;
  4367. begin
  4368. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4369. Pal.palVersion := $300;
  4370. Pal.palNumEntries := 256;
  4371. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4372. Pal.palPalEntry[Idx].peRed := Idx;
  4373. Pal.palPalEntry[Idx].peGreen := Idx;
  4374. Pal.palPalEntry[Idx].peBlue := Idx;
  4375. Pal.palPalEntry[Idx].peFlags := 0;
  4376. end;
  4377. Result := CreatePalette(Pal^);
  4378. FreeMem(Pal);
  4379. end;
  4380. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4381. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4382. var
  4383. Row: Integer;
  4384. pSource, pData: PByte;
  4385. begin
  4386. result := false;
  4387. if Assigned(Data) then begin
  4388. if Assigned(aBitmap) then begin
  4389. aBitmap.Width := Width;
  4390. aBitmap.Height := Height;
  4391. case Format of
  4392. tfAlpha8ub1, tfLuminance8ub1: begin
  4393. aBitmap.PixelFormat := pf8bit;
  4394. aBitmap.Palette := CreateGrayPalette;
  4395. end;
  4396. tfRGB5A1us1:
  4397. aBitmap.PixelFormat := pf15bit;
  4398. tfR5G6B5us1:
  4399. aBitmap.PixelFormat := pf16bit;
  4400. tfRGB8ub3, tfBGR8ub3:
  4401. aBitmap.PixelFormat := pf24bit;
  4402. tfRGBA8ub4, tfBGRA8ub4:
  4403. aBitmap.PixelFormat := pf32bit;
  4404. else
  4405. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4406. end;
  4407. pSource := Data;
  4408. for Row := 0 to FileHeight -1 do begin
  4409. pData := aBitmap.Scanline[Row];
  4410. Move(pSource^, pData^, fRowSize);
  4411. Inc(pSource, fRowSize);
  4412. if (Format in [tfRGB8ub3, tfRGBA8ub4]) then // swap RGB(A) to BGR(A)
  4413. SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
  4414. end;
  4415. result := true;
  4416. end;
  4417. end;
  4418. end;
  4419. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4420. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4421. var
  4422. pSource, pData, pTempData: PByte;
  4423. Row, RowSize, TempWidth, TempHeight: Integer;
  4424. IntFormat: TglBitmapFormat;
  4425. begin
  4426. result := false;
  4427. if (Assigned(aBitmap)) then begin
  4428. case aBitmap.PixelFormat of
  4429. pf8bit:
  4430. IntFormat := tfLuminance8ub1;
  4431. pf15bit:
  4432. IntFormat := tfRGB5A1us1;
  4433. pf16bit:
  4434. IntFormat := tfR5G6B5us1;
  4435. pf24bit:
  4436. IntFormat := tfBGR8ub3;
  4437. pf32bit:
  4438. IntFormat := tfBGRA8ub4;
  4439. else
  4440. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4441. end;
  4442. TempWidth := aBitmap.Width;
  4443. TempHeight := aBitmap.Height;
  4444. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4445. GetMem(pData, TempHeight * RowSize);
  4446. try
  4447. pTempData := pData;
  4448. for Row := 0 to TempHeight -1 do begin
  4449. pSource := aBitmap.Scanline[Row];
  4450. if (Assigned(pSource)) then begin
  4451. Move(pSource^, pTempData^, RowSize);
  4452. Inc(pTempData, RowSize);
  4453. end;
  4454. end;
  4455. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4456. result := true;
  4457. except
  4458. if Assigned(pData) then
  4459. FreeMem(pData);
  4460. raise;
  4461. end;
  4462. end;
  4463. end;
  4464. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4465. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4466. var
  4467. Row, Col, AlphaInterleave: Integer;
  4468. pSource, pDest: PByte;
  4469. begin
  4470. result := false;
  4471. if Assigned(Data) then begin
  4472. if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
  4473. if Assigned(aBitmap) then begin
  4474. aBitmap.PixelFormat := pf8bit;
  4475. aBitmap.Palette := CreateGrayPalette;
  4476. aBitmap.Width := Width;
  4477. aBitmap.Height := Height;
  4478. case Format of
  4479. tfLuminance8Alpha8ub2:
  4480. AlphaInterleave := 1;
  4481. tfRGBA8ub4, tfBGRA8ub4:
  4482. AlphaInterleave := 3;
  4483. else
  4484. AlphaInterleave := 0;
  4485. end;
  4486. // Copy Data
  4487. pSource := Data;
  4488. for Row := 0 to Height -1 do begin
  4489. pDest := aBitmap.Scanline[Row];
  4490. if Assigned(pDest) then begin
  4491. for Col := 0 to Width -1 do begin
  4492. Inc(pSource, AlphaInterleave);
  4493. pDest^ := pSource^;
  4494. Inc(pDest);
  4495. Inc(pSource);
  4496. end;
  4497. end;
  4498. end;
  4499. result := true;
  4500. end;
  4501. end;
  4502. end;
  4503. end;
  4504. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4505. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4506. var
  4507. tex: TglBitmap2D;
  4508. begin
  4509. tex := TglBitmap2D.Create;
  4510. try
  4511. tex.AssignFromBitmap(ABitmap);
  4512. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4513. finally
  4514. tex.Free;
  4515. end;
  4516. end;
  4517. {$ENDIF}
  4518. {$IFDEF GLB_LAZARUS}
  4519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4520. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4521. var
  4522. rid: TRawImageDescription;
  4523. FormatDesc: TFormatDescriptor;
  4524. begin
  4525. if not Assigned(Data) then
  4526. raise EglBitmap.Create('no pixel data assigned. load data before save');
  4527. result := false;
  4528. if not Assigned(aImage) or (Format = tfEmpty) then
  4529. exit;
  4530. FormatDesc := TFormatDescriptor.Get(Format);
  4531. if FormatDesc.IsCompressed then
  4532. exit;
  4533. FillChar(rid{%H-}, SizeOf(rid), 0);
  4534. if FormatDesc.IsGrayscale then
  4535. rid.Format := ricfGray
  4536. else
  4537. rid.Format := ricfRGBA;
  4538. rid.Width := Width;
  4539. rid.Height := Height;
  4540. rid.Depth := FormatDesc.BitsPerPixel;
  4541. rid.BitOrder := riboBitsInOrder;
  4542. rid.ByteOrder := riboLSBFirst;
  4543. rid.LineOrder := riloTopToBottom;
  4544. rid.LineEnd := rileTight;
  4545. rid.BitsPerPixel := FormatDesc.BitsPerPixel;
  4546. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4547. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4548. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4549. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4550. rid.RedShift := FormatDesc.Shift.r;
  4551. rid.GreenShift := FormatDesc.Shift.g;
  4552. rid.BlueShift := FormatDesc.Shift.b;
  4553. rid.AlphaShift := FormatDesc.Shift.a;
  4554. rid.MaskBitsPerPixel := 0;
  4555. rid.PaletteColorCount := 0;
  4556. aImage.DataDescription := rid;
  4557. aImage.CreateData;
  4558. if not Assigned(aImage.PixelData) then
  4559. raise EglBitmap.Create('error while creating LazIntfImage');
  4560. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4561. result := true;
  4562. end;
  4563. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4564. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4565. var
  4566. f: TglBitmapFormat;
  4567. FormatDesc: TFormatDescriptor;
  4568. ImageData: PByte;
  4569. ImageSize: Integer;
  4570. CanCopy: Boolean;
  4571. Mask: TglBitmapRec4ul;
  4572. procedure CopyConvert;
  4573. var
  4574. bfFormat: TbmpBitfieldFormat;
  4575. pSourceLine, pDestLine: PByte;
  4576. pSourceMD, pDestMD: Pointer;
  4577. Shift, Prec: TglBitmapRec4ub;
  4578. x, y: Integer;
  4579. pixel: TglBitmapPixelData;
  4580. begin
  4581. bfFormat := TbmpBitfieldFormat.Create;
  4582. with aImage.DataDescription do begin
  4583. Prec.r := RedPrec;
  4584. Prec.g := GreenPrec;
  4585. Prec.b := BluePrec;
  4586. Prec.a := AlphaPrec;
  4587. Shift.r := RedShift;
  4588. Shift.g := GreenShift;
  4589. Shift.b := BlueShift;
  4590. Shift.a := AlphaShift;
  4591. bfFormat.SetValues(BitsPerPixel, Prec, Shift);
  4592. end;
  4593. pSourceMD := bfFormat.CreateMappingData;
  4594. pDestMD := FormatDesc.CreateMappingData;
  4595. try
  4596. for y := 0 to aImage.Height-1 do begin
  4597. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  4598. pDestLine := ImageData + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
  4599. for x := 0 to aImage.Width-1 do begin
  4600. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  4601. FormatDesc.Map(pixel, pDestLine, pDestMD);
  4602. end;
  4603. end;
  4604. finally
  4605. FormatDesc.FreeMappingData(pDestMD);
  4606. bfFormat.FreeMappingData(pSourceMD);
  4607. bfFormat.Free;
  4608. end;
  4609. end;
  4610. begin
  4611. result := false;
  4612. if not Assigned(aImage) then
  4613. exit;
  4614. with aImage.DataDescription do begin
  4615. Mask.r := (QWord(1 shl RedPrec )-1) shl RedShift;
  4616. Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
  4617. Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
  4618. Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
  4619. end;
  4620. FormatDesc := TFormatDescriptor.GetFromMask(Mask);
  4621. f := FormatDesc.Format;
  4622. if (f = tfEmpty) then
  4623. exit;
  4624. CanCopy :=
  4625. (FormatDesc.BitsPerPixel = aImage.DataDescription.Depth) and
  4626. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  4627. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4628. ImageData := GetMem(ImageSize);
  4629. try
  4630. if CanCopy then
  4631. Move(aImage.PixelData^, ImageData^, ImageSize)
  4632. else
  4633. CopyConvert;
  4634. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4635. except
  4636. if Assigned(ImageData) then
  4637. FreeMem(ImageData);
  4638. raise;
  4639. end;
  4640. result := true;
  4641. end;
  4642. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4643. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4644. var
  4645. rid: TRawImageDescription;
  4646. FormatDesc: TFormatDescriptor;
  4647. Pixel: TglBitmapPixelData;
  4648. x, y: Integer;
  4649. srcMD: Pointer;
  4650. src, dst: PByte;
  4651. begin
  4652. result := false;
  4653. if not Assigned(aImage) or (Format = tfEmpty) then
  4654. exit;
  4655. FormatDesc := TFormatDescriptor.Get(Format);
  4656. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4657. exit;
  4658. FillChar(rid{%H-}, SizeOf(rid), 0);
  4659. rid.Format := ricfGray;
  4660. rid.Width := Width;
  4661. rid.Height := Height;
  4662. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4663. rid.BitOrder := riboBitsInOrder;
  4664. rid.ByteOrder := riboLSBFirst;
  4665. rid.LineOrder := riloTopToBottom;
  4666. rid.LineEnd := rileTight;
  4667. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4668. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4669. rid.GreenPrec := 0;
  4670. rid.BluePrec := 0;
  4671. rid.AlphaPrec := 0;
  4672. rid.RedShift := 0;
  4673. rid.GreenShift := 0;
  4674. rid.BlueShift := 0;
  4675. rid.AlphaShift := 0;
  4676. rid.MaskBitsPerPixel := 0;
  4677. rid.PaletteColorCount := 0;
  4678. aImage.DataDescription := rid;
  4679. aImage.CreateData;
  4680. srcMD := FormatDesc.CreateMappingData;
  4681. try
  4682. FormatDesc.PreparePixel(Pixel);
  4683. src := Data;
  4684. dst := aImage.PixelData;
  4685. for y := 0 to Height-1 do
  4686. for x := 0 to Width-1 do begin
  4687. FormatDesc.Unmap(src, Pixel, srcMD);
  4688. case rid.BitsPerPixel of
  4689. 8: begin
  4690. dst^ := Pixel.Data.a;
  4691. inc(dst);
  4692. end;
  4693. 16: begin
  4694. PWord(dst)^ := Pixel.Data.a;
  4695. inc(dst, 2);
  4696. end;
  4697. 24: begin
  4698. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4699. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4700. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4701. inc(dst, 3);
  4702. end;
  4703. 32: begin
  4704. PCardinal(dst)^ := Pixel.Data.a;
  4705. inc(dst, 4);
  4706. end;
  4707. else
  4708. raise EglBitmapUnsupportedFormat.Create(Format);
  4709. end;
  4710. end;
  4711. finally
  4712. FormatDesc.FreeMappingData(srcMD);
  4713. end;
  4714. result := true;
  4715. end;
  4716. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4717. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4718. var
  4719. tex: TglBitmap2D;
  4720. begin
  4721. tex := TglBitmap2D.Create;
  4722. try
  4723. tex.AssignFromLazIntfImage(aImage);
  4724. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4725. finally
  4726. tex.Free;
  4727. end;
  4728. end;
  4729. {$ENDIF}
  4730. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4731. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4732. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4733. var
  4734. rs: TResourceStream;
  4735. begin
  4736. PrepareResType(aResource, aResType);
  4737. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4738. try
  4739. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4740. finally
  4741. rs.Free;
  4742. end;
  4743. end;
  4744. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4745. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4746. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4747. var
  4748. rs: TResourceStream;
  4749. begin
  4750. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4751. try
  4752. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4753. finally
  4754. rs.Free;
  4755. end;
  4756. end;
  4757. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4758. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4759. begin
  4760. if TFormatDescriptor.Get(Format).IsCompressed then
  4761. raise EglBitmapUnsupportedFormat.Create(Format);
  4762. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4763. end;
  4764. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4765. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4766. var
  4767. FS: TFileStream;
  4768. begin
  4769. FS := TFileStream.Create(aFileName, fmOpenRead);
  4770. try
  4771. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4772. finally
  4773. FS.Free;
  4774. end;
  4775. end;
  4776. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4777. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4778. var
  4779. tex: TglBitmap2D;
  4780. begin
  4781. tex := TglBitmap2D.Create(aStream);
  4782. try
  4783. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4784. finally
  4785. tex.Free;
  4786. end;
  4787. end;
  4788. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4789. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4790. var
  4791. DestData, DestData2, SourceData: pByte;
  4792. TempHeight, TempWidth: Integer;
  4793. SourceFD, DestFD: TFormatDescriptor;
  4794. SourceMD, DestMD, DestMD2: Pointer;
  4795. FuncRec: TglBitmapFunctionRec;
  4796. begin
  4797. result := false;
  4798. Assert(Assigned(Data));
  4799. Assert(Assigned(aBitmap));
  4800. Assert(Assigned(aBitmap.Data));
  4801. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4802. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4803. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4804. DestFD := TFormatDescriptor.Get(Format);
  4805. if not Assigned(aFunc) then begin
  4806. aFunc := glBitmapAlphaFunc;
  4807. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4808. end else
  4809. FuncRec.Args := aArgs;
  4810. // Values
  4811. TempHeight := aBitmap.FileHeight;
  4812. TempWidth := aBitmap.FileWidth;
  4813. FuncRec.Sender := Self;
  4814. FuncRec.Size := Dimension;
  4815. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4816. DestData := Data;
  4817. DestData2 := Data;
  4818. SourceData := aBitmap.Data;
  4819. // Mapping
  4820. SourceFD.PreparePixel(FuncRec.Source);
  4821. DestFD.PreparePixel (FuncRec.Dest);
  4822. SourceMD := SourceFD.CreateMappingData;
  4823. DestMD := DestFD.CreateMappingData;
  4824. DestMD2 := DestFD.CreateMappingData;
  4825. try
  4826. FuncRec.Position.Y := 0;
  4827. while FuncRec.Position.Y < TempHeight do begin
  4828. FuncRec.Position.X := 0;
  4829. while FuncRec.Position.X < TempWidth do begin
  4830. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4831. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4832. aFunc(FuncRec);
  4833. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4834. inc(FuncRec.Position.X);
  4835. end;
  4836. inc(FuncRec.Position.Y);
  4837. end;
  4838. finally
  4839. SourceFD.FreeMappingData(SourceMD);
  4840. DestFD.FreeMappingData(DestMD);
  4841. DestFD.FreeMappingData(DestMD2);
  4842. end;
  4843. end;
  4844. end;
  4845. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4846. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4847. begin
  4848. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4849. end;
  4850. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4851. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4852. var
  4853. PixelData: TglBitmapPixelData;
  4854. begin
  4855. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  4856. result := AddAlphaFromColorKeyFloat(
  4857. aRed / PixelData.Range.r,
  4858. aGreen / PixelData.Range.g,
  4859. aBlue / PixelData.Range.b,
  4860. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4861. end;
  4862. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4863. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4864. var
  4865. values: array[0..2] of Single;
  4866. tmp: Cardinal;
  4867. i: Integer;
  4868. PixelData: TglBitmapPixelData;
  4869. begin
  4870. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  4871. with PixelData do begin
  4872. values[0] := aRed;
  4873. values[1] := aGreen;
  4874. values[2] := aBlue;
  4875. for i := 0 to 2 do begin
  4876. tmp := Trunc(Range.arr[i] * aDeviation);
  4877. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4878. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4879. end;
  4880. Data.a := 0;
  4881. Range.a := 0;
  4882. end;
  4883. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4884. end;
  4885. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4886. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4887. begin
  4888. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4889. end;
  4890. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4891. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4892. var
  4893. PixelData: TglBitmapPixelData;
  4894. begin
  4895. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  4896. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4897. end;
  4898. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4899. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4900. var
  4901. PixelData: TglBitmapPixelData;
  4902. begin
  4903. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  4904. with PixelData do
  4905. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4906. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4907. end;
  4908. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4909. function TglBitmap.RemoveAlpha: Boolean;
  4910. var
  4911. FormatDesc: TFormatDescriptor;
  4912. begin
  4913. result := false;
  4914. FormatDesc := TFormatDescriptor.Get(Format);
  4915. if Assigned(Data) then begin
  4916. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4917. raise EglBitmapUnsupportedFormat.Create(Format);
  4918. result := ConvertTo(FormatDesc.WithoutAlpha);
  4919. end;
  4920. end;
  4921. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4922. function TglBitmap.Clone: TglBitmap;
  4923. var
  4924. Temp: TglBitmap;
  4925. TempPtr: PByte;
  4926. Size: Integer;
  4927. begin
  4928. result := nil;
  4929. Temp := (ClassType.Create as TglBitmap);
  4930. try
  4931. // copy texture data if assigned
  4932. if Assigned(Data) then begin
  4933. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4934. GetMem(TempPtr, Size);
  4935. try
  4936. Move(Data^, TempPtr^, Size);
  4937. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4938. except
  4939. if Assigned(TempPtr) then
  4940. FreeMem(TempPtr);
  4941. raise;
  4942. end;
  4943. end else begin
  4944. TempPtr := nil;
  4945. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4946. end;
  4947. // copy properties
  4948. Temp.fID := ID;
  4949. Temp.fTarget := Target;
  4950. Temp.fFormat := Format;
  4951. Temp.fMipMap := MipMap;
  4952. Temp.fAnisotropic := Anisotropic;
  4953. Temp.fBorderColor := fBorderColor;
  4954. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4955. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4956. Temp.fFilterMin := fFilterMin;
  4957. Temp.fFilterMag := fFilterMag;
  4958. Temp.fWrapS := fWrapS;
  4959. Temp.fWrapT := fWrapT;
  4960. Temp.fWrapR := fWrapR;
  4961. Temp.fFilename := fFilename;
  4962. Temp.fCustomName := fCustomName;
  4963. Temp.fCustomNameW := fCustomNameW;
  4964. Temp.fCustomData := fCustomData;
  4965. result := Temp;
  4966. except
  4967. FreeAndNil(Temp);
  4968. raise;
  4969. end;
  4970. end;
  4971. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4972. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4973. var
  4974. SourceFD, DestFD: TFormatDescriptor;
  4975. SourcePD, DestPD: TglBitmapPixelData;
  4976. ShiftData: TShiftData;
  4977. function DataIsIdentical: Boolean;
  4978. begin
  4979. result := SourceFD.MaskMatch(DestFD.Mask);
  4980. end;
  4981. function CanCopyDirect: Boolean;
  4982. begin
  4983. result :=
  4984. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4985. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4986. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4987. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4988. end;
  4989. function CanShift: Boolean;
  4990. begin
  4991. result :=
  4992. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4993. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4994. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4995. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4996. end;
  4997. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4998. begin
  4999. result := 0;
  5000. while (aSource > aDest) and (aSource > 0) do begin
  5001. inc(result);
  5002. aSource := aSource shr 1;
  5003. end;
  5004. end;
  5005. begin
  5006. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  5007. SourceFD := TFormatDescriptor.Get(Format);
  5008. DestFD := TFormatDescriptor.Get(aFormat);
  5009. if DataIsIdentical then begin
  5010. result := true;
  5011. Format := aFormat;
  5012. exit;
  5013. end;
  5014. SourceFD.PreparePixel(SourcePD);
  5015. DestFD.PreparePixel (DestPD);
  5016. if CanCopyDirect then
  5017. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  5018. else if CanShift then begin
  5019. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  5020. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  5021. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  5022. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  5023. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  5024. end else
  5025. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  5026. end else
  5027. result := true;
  5028. end;
  5029. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5030. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  5031. begin
  5032. if aUseRGB or aUseAlpha then
  5033. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  5034. ((Byte(aUseAlpha) and 1) shl 1) or
  5035. (Byte(aUseRGB) and 1) ));
  5036. end;
  5037. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5038. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  5039. begin
  5040. fBorderColor[0] := aRed;
  5041. fBorderColor[1] := aGreen;
  5042. fBorderColor[2] := aBlue;
  5043. fBorderColor[3] := aAlpha;
  5044. if (ID > 0) then begin
  5045. Bind(false);
  5046. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  5047. end;
  5048. end;
  5049. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5050. procedure TglBitmap.FreeData;
  5051. var
  5052. TempPtr: PByte;
  5053. begin
  5054. TempPtr := nil;
  5055. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  5056. end;
  5057. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5058. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  5059. const aAlpha: Byte);
  5060. begin
  5061. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  5062. end;
  5063. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5064. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  5065. var
  5066. PixelData: TglBitmapPixelData;
  5067. begin
  5068. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5069. FillWithColorFloat(
  5070. aRed / PixelData.Range.r,
  5071. aGreen / PixelData.Range.g,
  5072. aBlue / PixelData.Range.b,
  5073. aAlpha / PixelData.Range.a);
  5074. end;
  5075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5076. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  5077. var
  5078. PixelData: TglBitmapPixelData;
  5079. begin
  5080. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  5081. with PixelData do begin
  5082. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  5083. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  5084. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  5085. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  5086. end;
  5087. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  5088. end;
  5089. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5090. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  5091. begin
  5092. //check MIN filter
  5093. case aMin of
  5094. GL_NEAREST:
  5095. fFilterMin := GL_NEAREST;
  5096. GL_LINEAR:
  5097. fFilterMin := GL_LINEAR;
  5098. GL_NEAREST_MIPMAP_NEAREST:
  5099. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  5100. GL_LINEAR_MIPMAP_NEAREST:
  5101. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  5102. GL_NEAREST_MIPMAP_LINEAR:
  5103. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  5104. GL_LINEAR_MIPMAP_LINEAR:
  5105. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  5106. else
  5107. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  5108. end;
  5109. //check MAG filter
  5110. case aMag of
  5111. GL_NEAREST:
  5112. fFilterMag := GL_NEAREST;
  5113. GL_LINEAR:
  5114. fFilterMag := GL_LINEAR;
  5115. else
  5116. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  5117. end;
  5118. //apply filter
  5119. if (ID > 0) then begin
  5120. Bind(false);
  5121. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  5122. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  5123. case fFilterMin of
  5124. GL_NEAREST, GL_LINEAR:
  5125. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5126. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  5127. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  5128. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  5129. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  5130. end;
  5131. end else
  5132. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5133. end;
  5134. end;
  5135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5136. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  5137. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  5138. begin
  5139. case aValue of
  5140. GL_CLAMP:
  5141. aTarget := GL_CLAMP;
  5142. GL_REPEAT:
  5143. aTarget := GL_REPEAT;
  5144. GL_CLAMP_TO_EDGE: begin
  5145. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  5146. aTarget := GL_CLAMP_TO_EDGE
  5147. else
  5148. aTarget := GL_CLAMP;
  5149. end;
  5150. GL_CLAMP_TO_BORDER: begin
  5151. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  5152. aTarget := GL_CLAMP_TO_BORDER
  5153. else
  5154. aTarget := GL_CLAMP;
  5155. end;
  5156. GL_MIRRORED_REPEAT: begin
  5157. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  5158. aTarget := GL_MIRRORED_REPEAT
  5159. else
  5160. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  5161. end;
  5162. else
  5163. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  5164. end;
  5165. end;
  5166. begin
  5167. CheckAndSetWrap(S, fWrapS);
  5168. CheckAndSetWrap(T, fWrapT);
  5169. CheckAndSetWrap(R, fWrapR);
  5170. if (ID > 0) then begin
  5171. Bind(false);
  5172. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  5173. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  5174. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  5175. end;
  5176. end;
  5177. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5178. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  5179. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  5180. begin
  5181. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  5182. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  5183. fSwizzle[aIndex] := aValue
  5184. else
  5185. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  5186. end;
  5187. begin
  5188. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  5189. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  5190. CheckAndSetValue(r, 0);
  5191. CheckAndSetValue(g, 1);
  5192. CheckAndSetValue(b, 2);
  5193. CheckAndSetValue(a, 3);
  5194. if (ID > 0) then begin
  5195. Bind(false);
  5196. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  5197. end;
  5198. end;
  5199. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5200. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  5201. begin
  5202. if aEnableTextureUnit then
  5203. glEnable(Target);
  5204. if (ID > 0) then
  5205. glBindTexture(Target, ID);
  5206. end;
  5207. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5208. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  5209. begin
  5210. if aDisableTextureUnit then
  5211. glDisable(Target);
  5212. glBindTexture(Target, 0);
  5213. end;
  5214. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5215. constructor TglBitmap.Create;
  5216. begin
  5217. if (ClassType = TglBitmap) then
  5218. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  5219. {$IFDEF GLB_NATIVE_OGL}
  5220. glbReadOpenGLExtensions;
  5221. {$ENDIF}
  5222. inherited Create;
  5223. fFormat := glBitmapGetDefaultFormat;
  5224. fFreeDataOnDestroy := true;
  5225. end;
  5226. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5227. constructor TglBitmap.Create(const aFileName: String);
  5228. begin
  5229. Create;
  5230. LoadFromFile(aFileName);
  5231. end;
  5232. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5233. constructor TglBitmap.Create(const aStream: TStream);
  5234. begin
  5235. Create;
  5236. LoadFromStream(aStream);
  5237. end;
  5238. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5239. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
  5240. var
  5241. ImageSize: Integer;
  5242. begin
  5243. Create;
  5244. if not Assigned(aData) then begin
  5245. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5246. GetMem(aData, ImageSize);
  5247. try
  5248. FillChar(aData^, ImageSize, #$FF);
  5249. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5250. except
  5251. if Assigned(aData) then
  5252. FreeMem(aData);
  5253. raise;
  5254. end;
  5255. end else begin
  5256. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5257. fFreeDataOnDestroy := false;
  5258. end;
  5259. end;
  5260. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5261. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5262. begin
  5263. Create;
  5264. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  5265. end;
  5266. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5267. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  5268. begin
  5269. Create;
  5270. LoadFromResource(aInstance, aResource, aResType);
  5271. end;
  5272. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5273. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5274. begin
  5275. Create;
  5276. LoadFromResourceID(aInstance, aResourceID, aResType);
  5277. end;
  5278. {$IFDEF GLB_SUPPORT_PNG_READ}
  5279. {$IF DEFINED(GLB_LAZ_PNG)}
  5280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5281. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5282. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5283. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5284. const
  5285. MAGIC_LEN = 8;
  5286. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  5287. var
  5288. reader: TLazReaderPNG;
  5289. intf: TLazIntfImage;
  5290. StreamPos: Int64;
  5291. magic: String[MAGIC_LEN];
  5292. begin
  5293. result := true;
  5294. StreamPos := aStream.Position;
  5295. SetLength(magic, MAGIC_LEN);
  5296. aStream.Read(magic[1], MAGIC_LEN);
  5297. aStream.Position := StreamPos;
  5298. if (magic <> PNG_MAGIC) then begin
  5299. result := false;
  5300. exit;
  5301. end;
  5302. intf := TLazIntfImage.Create(0, 0);
  5303. reader := TLazReaderPNG.Create;
  5304. try try
  5305. reader.UpdateDescription := true;
  5306. reader.ImageRead(aStream, intf);
  5307. AssignFromLazIntfImage(intf);
  5308. except
  5309. result := false;
  5310. aStream.Position := StreamPos;
  5311. exit;
  5312. end;
  5313. finally
  5314. reader.Free;
  5315. intf.Free;
  5316. end;
  5317. end;
  5318. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5319. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5320. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5321. var
  5322. Surface: PSDL_Surface;
  5323. RWops: PSDL_RWops;
  5324. begin
  5325. result := false;
  5326. RWops := glBitmapCreateRWops(aStream);
  5327. try
  5328. if IMG_isPNG(RWops) > 0 then begin
  5329. Surface := IMG_LoadPNG_RW(RWops);
  5330. try
  5331. AssignFromSurface(Surface);
  5332. result := true;
  5333. finally
  5334. SDL_FreeSurface(Surface);
  5335. end;
  5336. end;
  5337. finally
  5338. SDL_FreeRW(RWops);
  5339. end;
  5340. end;
  5341. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5342. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5343. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5344. begin
  5345. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5346. end;
  5347. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5348. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5349. var
  5350. StreamPos: Int64;
  5351. signature: array [0..7] of byte;
  5352. png: png_structp;
  5353. png_info: png_infop;
  5354. TempHeight, TempWidth: Integer;
  5355. Format: TglBitmapFormat;
  5356. png_data: pByte;
  5357. png_rows: array of pByte;
  5358. Row, LineSize: Integer;
  5359. begin
  5360. result := false;
  5361. if not init_libPNG then
  5362. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5363. try
  5364. // signature
  5365. StreamPos := aStream.Position;
  5366. aStream.Read(signature{%H-}, 8);
  5367. aStream.Position := StreamPos;
  5368. if png_check_sig(@signature, 8) <> 0 then begin
  5369. // png read struct
  5370. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5371. if png = nil then
  5372. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5373. // png info
  5374. png_info := png_create_info_struct(png);
  5375. if png_info = nil then begin
  5376. png_destroy_read_struct(@png, nil, nil);
  5377. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5378. end;
  5379. // set read callback
  5380. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5381. // read informations
  5382. png_read_info(png, png_info);
  5383. // size
  5384. TempHeight := png_get_image_height(png, png_info);
  5385. TempWidth := png_get_image_width(png, png_info);
  5386. // format
  5387. case png_get_color_type(png, png_info) of
  5388. PNG_COLOR_TYPE_GRAY:
  5389. Format := tfLuminance8ub1;
  5390. PNG_COLOR_TYPE_GRAY_ALPHA:
  5391. Format := tfLuminance8Alpha8us1;
  5392. PNG_COLOR_TYPE_RGB:
  5393. Format := tfRGB8ub3;
  5394. PNG_COLOR_TYPE_RGB_ALPHA:
  5395. Format := tfRGBA8ub4;
  5396. else
  5397. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5398. end;
  5399. // cut upper 8 bit from 16 bit formats
  5400. if png_get_bit_depth(png, png_info) > 8 then
  5401. png_set_strip_16(png);
  5402. // expand bitdepth smaller than 8
  5403. if png_get_bit_depth(png, png_info) < 8 then
  5404. png_set_expand(png);
  5405. // allocating mem for scanlines
  5406. LineSize := png_get_rowbytes(png, png_info);
  5407. GetMem(png_data, TempHeight * LineSize);
  5408. try
  5409. SetLength(png_rows, TempHeight);
  5410. for Row := Low(png_rows) to High(png_rows) do begin
  5411. png_rows[Row] := png_data;
  5412. Inc(png_rows[Row], Row * LineSize);
  5413. end;
  5414. // read complete image into scanlines
  5415. png_read_image(png, @png_rows[0]);
  5416. // read end
  5417. png_read_end(png, png_info);
  5418. // destroy read struct
  5419. png_destroy_read_struct(@png, @png_info, nil);
  5420. SetLength(png_rows, 0);
  5421. // set new data
  5422. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5423. result := true;
  5424. except
  5425. if Assigned(png_data) then
  5426. FreeMem(png_data);
  5427. raise;
  5428. end;
  5429. end;
  5430. finally
  5431. quit_libPNG;
  5432. end;
  5433. end;
  5434. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5435. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5436. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5437. var
  5438. StreamPos: Int64;
  5439. Png: TPNGObject;
  5440. Header: String[8];
  5441. Row, Col, PixSize, LineSize: Integer;
  5442. NewImage, pSource, pDest, pAlpha: pByte;
  5443. PngFormat: TglBitmapFormat;
  5444. FormatDesc: TFormatDescriptor;
  5445. const
  5446. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5447. begin
  5448. result := false;
  5449. StreamPos := aStream.Position;
  5450. aStream.Read(Header[0], SizeOf(Header));
  5451. aStream.Position := StreamPos;
  5452. {Test if the header matches}
  5453. if Header = PngHeader then begin
  5454. Png := TPNGObject.Create;
  5455. try
  5456. Png.LoadFromStream(aStream);
  5457. case Png.Header.ColorType of
  5458. COLOR_GRAYSCALE:
  5459. PngFormat := tfLuminance8ub1;
  5460. COLOR_GRAYSCALEALPHA:
  5461. PngFormat := tfLuminance8Alpha8us1;
  5462. COLOR_RGB:
  5463. PngFormat := tfBGR8ub3;
  5464. COLOR_RGBALPHA:
  5465. PngFormat := tfBGRA8ub4;
  5466. else
  5467. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5468. end;
  5469. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5470. PixSize := Round(FormatDesc.PixelSize);
  5471. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5472. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5473. try
  5474. pDest := NewImage;
  5475. case Png.Header.ColorType of
  5476. COLOR_RGB, COLOR_GRAYSCALE:
  5477. begin
  5478. for Row := 0 to Png.Height -1 do begin
  5479. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5480. Inc(pDest, LineSize);
  5481. end;
  5482. end;
  5483. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5484. begin
  5485. PixSize := PixSize -1;
  5486. for Row := 0 to Png.Height -1 do begin
  5487. pSource := Png.Scanline[Row];
  5488. pAlpha := pByte(Png.AlphaScanline[Row]);
  5489. for Col := 0 to Png.Width -1 do begin
  5490. Move (pSource^, pDest^, PixSize);
  5491. Inc(pSource, PixSize);
  5492. Inc(pDest, PixSize);
  5493. pDest^ := pAlpha^;
  5494. inc(pAlpha);
  5495. Inc(pDest);
  5496. end;
  5497. end;
  5498. end;
  5499. else
  5500. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5501. end;
  5502. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5503. result := true;
  5504. except
  5505. if Assigned(NewImage) then
  5506. FreeMem(NewImage);
  5507. raise;
  5508. end;
  5509. finally
  5510. Png.Free;
  5511. end;
  5512. end;
  5513. end;
  5514. {$IFEND}
  5515. {$ENDIF}
  5516. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5517. {$IFDEF GLB_LIB_PNG}
  5518. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5519. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5520. begin
  5521. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5522. end;
  5523. {$ENDIF}
  5524. {$IF DEFINED(GLB_LAZ_PNG)}
  5525. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5526. procedure TglBitmap.SavePNG(const aStream: TStream);
  5527. var
  5528. png: TPortableNetworkGraphic;
  5529. intf: TLazIntfImage;
  5530. raw: TRawImage;
  5531. begin
  5532. png := TPortableNetworkGraphic.Create;
  5533. intf := TLazIntfImage.Create(0, 0);
  5534. try
  5535. if not AssignToLazIntfImage(intf) then
  5536. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5537. intf.GetRawImage(raw);
  5538. png.LoadFromRawImage(raw, false);
  5539. png.SaveToStream(aStream);
  5540. finally
  5541. png.Free;
  5542. intf.Free;
  5543. end;
  5544. end;
  5545. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5546. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5547. procedure TglBitmap.SavePNG(const aStream: TStream);
  5548. var
  5549. png: png_structp;
  5550. png_info: png_infop;
  5551. png_rows: array of pByte;
  5552. LineSize: Integer;
  5553. ColorType: Integer;
  5554. Row: Integer;
  5555. FormatDesc: TFormatDescriptor;
  5556. begin
  5557. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5558. raise EglBitmapUnsupportedFormat.Create(Format);
  5559. if not init_libPNG then
  5560. raise Exception.Create('unable to initialize libPNG.');
  5561. try
  5562. case Format of
  5563. tfAlpha8ub1, tfLuminance8ub1:
  5564. ColorType := PNG_COLOR_TYPE_GRAY;
  5565. tfLuminance8Alpha8us1:
  5566. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5567. tfBGR8ub3, tfRGB8ub3:
  5568. ColorType := PNG_COLOR_TYPE_RGB;
  5569. tfBGRA8ub4, tfRGBA8ub4:
  5570. ColorType := PNG_COLOR_TYPE_RGBA;
  5571. else
  5572. raise EglBitmapUnsupportedFormat.Create(Format);
  5573. end;
  5574. FormatDesc := TFormatDescriptor.Get(Format);
  5575. LineSize := FormatDesc.GetSize(Width, 1);
  5576. // creating array for scanline
  5577. SetLength(png_rows, Height);
  5578. try
  5579. for Row := 0 to Height - 1 do begin
  5580. png_rows[Row] := Data;
  5581. Inc(png_rows[Row], Row * LineSize)
  5582. end;
  5583. // write struct
  5584. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5585. if png = nil then
  5586. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5587. // create png info
  5588. png_info := png_create_info_struct(png);
  5589. if png_info = nil then begin
  5590. png_destroy_write_struct(@png, nil);
  5591. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5592. end;
  5593. // set read callback
  5594. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5595. // set compression
  5596. png_set_compression_level(png, 6);
  5597. if Format in [tfBGR8ub3, tfBGRA8ub4] then
  5598. png_set_bgr(png);
  5599. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5600. png_write_info(png, png_info);
  5601. png_write_image(png, @png_rows[0]);
  5602. png_write_end(png, png_info);
  5603. png_destroy_write_struct(@png, @png_info);
  5604. finally
  5605. SetLength(png_rows, 0);
  5606. end;
  5607. finally
  5608. quit_libPNG;
  5609. end;
  5610. end;
  5611. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5612. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5613. procedure TglBitmap.SavePNG(const aStream: TStream);
  5614. var
  5615. Png: TPNGObject;
  5616. pSource, pDest: pByte;
  5617. X, Y, PixSize: Integer;
  5618. ColorType: Cardinal;
  5619. Alpha: Boolean;
  5620. pTemp: pByte;
  5621. Temp: Byte;
  5622. begin
  5623. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5624. raise EglBitmapUnsupportedFormat.Create(Format);
  5625. case Format of
  5626. tfAlpha8ub1, tfLuminance8ub1: begin
  5627. ColorType := COLOR_GRAYSCALE;
  5628. PixSize := 1;
  5629. Alpha := false;
  5630. end;
  5631. tfLuminance8Alpha8us1: begin
  5632. ColorType := COLOR_GRAYSCALEALPHA;
  5633. PixSize := 1;
  5634. Alpha := true;
  5635. end;
  5636. tfBGR8ub3, tfRGB8ub3: begin
  5637. ColorType := COLOR_RGB;
  5638. PixSize := 3;
  5639. Alpha := false;
  5640. end;
  5641. tfBGRA8ub4, tfRGBA8ub4: begin
  5642. ColorType := COLOR_RGBALPHA;
  5643. PixSize := 3;
  5644. Alpha := true
  5645. end;
  5646. else
  5647. raise EglBitmapUnsupportedFormat.Create(Format);
  5648. end;
  5649. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5650. try
  5651. // Copy ImageData
  5652. pSource := Data;
  5653. for Y := 0 to Height -1 do begin
  5654. pDest := png.ScanLine[Y];
  5655. for X := 0 to Width -1 do begin
  5656. Move(pSource^, pDest^, PixSize);
  5657. Inc(pDest, PixSize);
  5658. Inc(pSource, PixSize);
  5659. if Alpha then begin
  5660. png.AlphaScanline[Y]^[X] := pSource^;
  5661. Inc(pSource);
  5662. end;
  5663. end;
  5664. // convert RGB line to BGR
  5665. if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
  5666. pTemp := png.ScanLine[Y];
  5667. for X := 0 to Width -1 do begin
  5668. Temp := pByteArray(pTemp)^[0];
  5669. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5670. pByteArray(pTemp)^[2] := Temp;
  5671. Inc(pTemp, 3);
  5672. end;
  5673. end;
  5674. end;
  5675. // Save to Stream
  5676. Png.CompressionLevel := 6;
  5677. Png.SaveToStream(aStream);
  5678. finally
  5679. FreeAndNil(Png);
  5680. end;
  5681. end;
  5682. {$IFEND}
  5683. {$ENDIF}
  5684. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5685. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5686. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5687. {$IFDEF GLB_LIB_JPEG}
  5688. type
  5689. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5690. glBitmap_libJPEG_source_mgr = record
  5691. pub: jpeg_source_mgr;
  5692. SrcStream: TStream;
  5693. SrcBuffer: array [1..4096] of byte;
  5694. end;
  5695. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5696. glBitmap_libJPEG_dest_mgr = record
  5697. pub: jpeg_destination_mgr;
  5698. DestStream: TStream;
  5699. DestBuffer: array [1..4096] of byte;
  5700. end;
  5701. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5702. begin
  5703. //DUMMY
  5704. end;
  5705. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5706. begin
  5707. //DUMMY
  5708. end;
  5709. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5710. begin
  5711. //DUMMY
  5712. end;
  5713. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5714. begin
  5715. //DUMMY
  5716. end;
  5717. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5718. begin
  5719. //DUMMY
  5720. end;
  5721. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5722. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5723. var
  5724. src: glBitmap_libJPEG_source_mgr_ptr;
  5725. bytes: integer;
  5726. begin
  5727. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5728. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5729. if (bytes <= 0) then begin
  5730. src^.SrcBuffer[1] := $FF;
  5731. src^.SrcBuffer[2] := JPEG_EOI;
  5732. bytes := 2;
  5733. end;
  5734. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5735. src^.pub.bytes_in_buffer := bytes;
  5736. result := true;
  5737. end;
  5738. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5739. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5740. var
  5741. src: glBitmap_libJPEG_source_mgr_ptr;
  5742. begin
  5743. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5744. if num_bytes > 0 then begin
  5745. // wanted byte isn't in buffer so set stream position and read buffer
  5746. if num_bytes > src^.pub.bytes_in_buffer then begin
  5747. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5748. src^.pub.fill_input_buffer(cinfo);
  5749. end else begin
  5750. // wanted byte is in buffer so only skip
  5751. inc(src^.pub.next_input_byte, num_bytes);
  5752. dec(src^.pub.bytes_in_buffer, num_bytes);
  5753. end;
  5754. end;
  5755. end;
  5756. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5757. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5758. var
  5759. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5760. begin
  5761. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5762. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5763. // write complete buffer
  5764. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5765. // reset buffer
  5766. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5767. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5768. end;
  5769. result := true;
  5770. end;
  5771. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5772. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5773. var
  5774. Idx: Integer;
  5775. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5776. begin
  5777. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5778. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5779. // check for endblock
  5780. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5781. // write endblock
  5782. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5783. // leave
  5784. break;
  5785. end else
  5786. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5787. end;
  5788. end;
  5789. {$ENDIF}
  5790. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5791. {$IF DEFINED(GLB_LAZ_JPEG)}
  5792. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5793. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5794. const
  5795. MAGIC_LEN = 2;
  5796. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  5797. var
  5798. intf: TLazIntfImage;
  5799. reader: TFPReaderJPEG;
  5800. StreamPos: Int64;
  5801. magic: String[MAGIC_LEN];
  5802. begin
  5803. result := true;
  5804. StreamPos := aStream.Position;
  5805. SetLength(magic, MAGIC_LEN);
  5806. aStream.Read(magic[1], MAGIC_LEN);
  5807. aStream.Position := StreamPos;
  5808. if (magic <> JPEG_MAGIC) then begin
  5809. result := false;
  5810. exit;
  5811. end;
  5812. reader := TFPReaderJPEG.Create;
  5813. intf := TLazIntfImage.Create(0, 0);
  5814. try try
  5815. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  5816. reader.ImageRead(aStream, intf);
  5817. AssignFromLazIntfImage(intf);
  5818. except
  5819. result := false;
  5820. aStream.Position := StreamPos;
  5821. exit;
  5822. end;
  5823. finally
  5824. reader.Free;
  5825. intf.Free;
  5826. end;
  5827. end;
  5828. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5829. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5830. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5831. var
  5832. Surface: PSDL_Surface;
  5833. RWops: PSDL_RWops;
  5834. begin
  5835. result := false;
  5836. RWops := glBitmapCreateRWops(aStream);
  5837. try
  5838. if IMG_isJPG(RWops) > 0 then begin
  5839. Surface := IMG_LoadJPG_RW(RWops);
  5840. try
  5841. AssignFromSurface(Surface);
  5842. result := true;
  5843. finally
  5844. SDL_FreeSurface(Surface);
  5845. end;
  5846. end;
  5847. finally
  5848. SDL_FreeRW(RWops);
  5849. end;
  5850. end;
  5851. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5852. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5853. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5854. var
  5855. StreamPos: Int64;
  5856. Temp: array[0..1]of Byte;
  5857. jpeg: jpeg_decompress_struct;
  5858. jpeg_err: jpeg_error_mgr;
  5859. IntFormat: TglBitmapFormat;
  5860. pImage: pByte;
  5861. TempHeight, TempWidth: Integer;
  5862. pTemp: pByte;
  5863. Row: Integer;
  5864. FormatDesc: TFormatDescriptor;
  5865. begin
  5866. result := false;
  5867. if not init_libJPEG then
  5868. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5869. try
  5870. // reading first two bytes to test file and set cursor back to begin
  5871. StreamPos := aStream.Position;
  5872. aStream.Read({%H-}Temp[0], 2);
  5873. aStream.Position := StreamPos;
  5874. // if Bitmap then read file.
  5875. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5876. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5877. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5878. // error managment
  5879. jpeg.err := jpeg_std_error(@jpeg_err);
  5880. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5881. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5882. // decompression struct
  5883. jpeg_create_decompress(@jpeg);
  5884. // allocation space for streaming methods
  5885. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5886. // seeting up custom functions
  5887. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5888. pub.init_source := glBitmap_libJPEG_init_source;
  5889. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5890. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5891. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5892. pub.term_source := glBitmap_libJPEG_term_source;
  5893. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5894. pub.next_input_byte := nil; // until buffer loaded
  5895. SrcStream := aStream;
  5896. end;
  5897. // set global decoding state
  5898. jpeg.global_state := DSTATE_START;
  5899. // read header of jpeg
  5900. jpeg_read_header(@jpeg, false);
  5901. // setting output parameter
  5902. case jpeg.jpeg_color_space of
  5903. JCS_GRAYSCALE:
  5904. begin
  5905. jpeg.out_color_space := JCS_GRAYSCALE;
  5906. IntFormat := tfLuminance8ub1;
  5907. end;
  5908. else
  5909. jpeg.out_color_space := JCS_RGB;
  5910. IntFormat := tfRGB8ub3;
  5911. end;
  5912. // reading image
  5913. jpeg_start_decompress(@jpeg);
  5914. TempHeight := jpeg.output_height;
  5915. TempWidth := jpeg.output_width;
  5916. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5917. // creating new image
  5918. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5919. try
  5920. pTemp := pImage;
  5921. for Row := 0 to TempHeight -1 do begin
  5922. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5923. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5924. end;
  5925. // finish decompression
  5926. jpeg_finish_decompress(@jpeg);
  5927. // destroy decompression
  5928. jpeg_destroy_decompress(@jpeg);
  5929. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5930. result := true;
  5931. except
  5932. if Assigned(pImage) then
  5933. FreeMem(pImage);
  5934. raise;
  5935. end;
  5936. end;
  5937. finally
  5938. quit_libJPEG;
  5939. end;
  5940. end;
  5941. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5942. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5943. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5944. var
  5945. bmp: TBitmap;
  5946. jpg: TJPEGImage;
  5947. StreamPos: Int64;
  5948. Temp: array[0..1]of Byte;
  5949. begin
  5950. result := false;
  5951. // reading first two bytes to test file and set cursor back to begin
  5952. StreamPos := aStream.Position;
  5953. aStream.Read(Temp[0], 2);
  5954. aStream.Position := StreamPos;
  5955. // if Bitmap then read file.
  5956. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5957. bmp := TBitmap.Create;
  5958. try
  5959. jpg := TJPEGImage.Create;
  5960. try
  5961. jpg.LoadFromStream(aStream);
  5962. bmp.Assign(jpg);
  5963. result := AssignFromBitmap(bmp);
  5964. finally
  5965. jpg.Free;
  5966. end;
  5967. finally
  5968. bmp.Free;
  5969. end;
  5970. end;
  5971. end;
  5972. {$IFEND}
  5973. {$ENDIF}
  5974. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5975. {$IF DEFINED(GLB_LAZ_JPEG)}
  5976. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5977. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5978. var
  5979. jpeg: TJPEGImage;
  5980. intf: TLazIntfImage;
  5981. raw: TRawImage;
  5982. begin
  5983. jpeg := TJPEGImage.Create;
  5984. intf := TLazIntfImage.Create(0, 0);
  5985. try
  5986. if not AssignToLazIntfImage(intf) then
  5987. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5988. intf.GetRawImage(raw);
  5989. jpeg.LoadFromRawImage(raw, false);
  5990. jpeg.SaveToStream(aStream);
  5991. finally
  5992. intf.Free;
  5993. jpeg.Free;
  5994. end;
  5995. end;
  5996. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5997. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5998. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5999. var
  6000. jpeg: jpeg_compress_struct;
  6001. jpeg_err: jpeg_error_mgr;
  6002. Row: Integer;
  6003. pTemp, pTemp2: pByte;
  6004. procedure CopyRow(pDest, pSource: pByte);
  6005. var
  6006. X: Integer;
  6007. begin
  6008. for X := 0 to Width - 1 do begin
  6009. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  6010. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  6011. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  6012. Inc(pDest, 3);
  6013. Inc(pSource, 3);
  6014. end;
  6015. end;
  6016. begin
  6017. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6018. raise EglBitmapUnsupportedFormat.Create(Format);
  6019. if not init_libJPEG then
  6020. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  6021. try
  6022. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  6023. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  6024. // error managment
  6025. jpeg.err := jpeg_std_error(@jpeg_err);
  6026. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  6027. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  6028. // compression struct
  6029. jpeg_create_compress(@jpeg);
  6030. // allocation space for streaming methods
  6031. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  6032. // seeting up custom functions
  6033. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  6034. pub.init_destination := glBitmap_libJPEG_init_destination;
  6035. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  6036. pub.term_destination := glBitmap_libJPEG_term_destination;
  6037. pub.next_output_byte := @DestBuffer[1];
  6038. pub.free_in_buffer := Length(DestBuffer);
  6039. DestStream := aStream;
  6040. end;
  6041. // very important state
  6042. jpeg.global_state := CSTATE_START;
  6043. jpeg.image_width := Width;
  6044. jpeg.image_height := Height;
  6045. case Format of
  6046. tfAlpha8ub1, tfLuminance8ub1: begin
  6047. jpeg.input_components := 1;
  6048. jpeg.in_color_space := JCS_GRAYSCALE;
  6049. end;
  6050. tfRGB8ub3, tfBGR8ub3: begin
  6051. jpeg.input_components := 3;
  6052. jpeg.in_color_space := JCS_RGB;
  6053. end;
  6054. end;
  6055. jpeg_set_defaults(@jpeg);
  6056. jpeg_set_quality(@jpeg, 95, true);
  6057. jpeg_start_compress(@jpeg, true);
  6058. pTemp := Data;
  6059. if Format = tfBGR8ub3 then
  6060. GetMem(pTemp2, fRowSize)
  6061. else
  6062. pTemp2 := pTemp;
  6063. try
  6064. for Row := 0 to jpeg.image_height -1 do begin
  6065. // prepare row
  6066. if Format = tfBGR8ub3 then
  6067. CopyRow(pTemp2, pTemp)
  6068. else
  6069. pTemp2 := pTemp;
  6070. // write row
  6071. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  6072. inc(pTemp, fRowSize);
  6073. end;
  6074. finally
  6075. // free memory
  6076. if Format = tfBGR8ub3 then
  6077. FreeMem(pTemp2);
  6078. end;
  6079. jpeg_finish_compress(@jpeg);
  6080. jpeg_destroy_compress(@jpeg);
  6081. finally
  6082. quit_libJPEG;
  6083. end;
  6084. end;
  6085. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  6086. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6087. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6088. var
  6089. Bmp: TBitmap;
  6090. Jpg: TJPEGImage;
  6091. begin
  6092. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6093. raise EglBitmapUnsupportedFormat.Create(Format);
  6094. Bmp := TBitmap.Create;
  6095. try
  6096. Jpg := TJPEGImage.Create;
  6097. try
  6098. AssignToBitmap(Bmp);
  6099. if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
  6100. Jpg.Grayscale := true;
  6101. Jpg.PixelFormat := jf8Bit;
  6102. end;
  6103. Jpg.Assign(Bmp);
  6104. Jpg.SaveToStream(aStream);
  6105. finally
  6106. FreeAndNil(Jpg);
  6107. end;
  6108. finally
  6109. FreeAndNil(Bmp);
  6110. end;
  6111. end;
  6112. {$IFEND}
  6113. {$ENDIF}
  6114. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6115. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6116. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6117. const
  6118. BMP_MAGIC = $4D42;
  6119. BMP_COMP_RGB = 0;
  6120. BMP_COMP_RLE8 = 1;
  6121. BMP_COMP_RLE4 = 2;
  6122. BMP_COMP_BITFIELDS = 3;
  6123. type
  6124. TBMPHeader = packed record
  6125. bfType: Word;
  6126. bfSize: Cardinal;
  6127. bfReserved1: Word;
  6128. bfReserved2: Word;
  6129. bfOffBits: Cardinal;
  6130. end;
  6131. TBMPInfo = packed record
  6132. biSize: Cardinal;
  6133. biWidth: Longint;
  6134. biHeight: Longint;
  6135. biPlanes: Word;
  6136. biBitCount: Word;
  6137. biCompression: Cardinal;
  6138. biSizeImage: Cardinal;
  6139. biXPelsPerMeter: Longint;
  6140. biYPelsPerMeter: Longint;
  6141. biClrUsed: Cardinal;
  6142. biClrImportant: Cardinal;
  6143. end;
  6144. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6145. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  6146. //////////////////////////////////////////////////////////////////////////////////////////////////
  6147. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
  6148. begin
  6149. result := tfEmpty;
  6150. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  6151. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  6152. //Read Compression
  6153. case aInfo.biCompression of
  6154. BMP_COMP_RLE4,
  6155. BMP_COMP_RLE8: begin
  6156. raise EglBitmap.Create('RLE compression is not supported');
  6157. end;
  6158. BMP_COMP_BITFIELDS: begin
  6159. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  6160. aStream.Read(aMask.r, SizeOf(aMask.r));
  6161. aStream.Read(aMask.g, SizeOf(aMask.g));
  6162. aStream.Read(aMask.b, SizeOf(aMask.b));
  6163. aStream.Read(aMask.a, SizeOf(aMask.a));
  6164. end else
  6165. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  6166. end;
  6167. end;
  6168. //get suitable format
  6169. case aInfo.biBitCount of
  6170. 8: result := tfLuminance8ub1;
  6171. 16: result := tfX1RGB5us1;
  6172. 24: result := tfBGR8ub3;
  6173. 32: result := tfXRGB8ui1;
  6174. end;
  6175. end;
  6176. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  6177. var
  6178. i, c: Integer;
  6179. ColorTable: TbmpColorTable;
  6180. begin
  6181. result := nil;
  6182. if (aInfo.biBitCount >= 16) then
  6183. exit;
  6184. aFormat := tfLuminance8ub1;
  6185. c := aInfo.biClrUsed;
  6186. if (c = 0) then
  6187. c := 1 shl aInfo.biBitCount;
  6188. SetLength(ColorTable, c);
  6189. for i := 0 to c-1 do begin
  6190. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  6191. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  6192. aFormat := tfRGB8ub3;
  6193. end;
  6194. result := TbmpColorTableFormat.Create;
  6195. result.BitsPerPixel := aInfo.biBitCount;
  6196. result.ColorTable := ColorTable;
  6197. result.CalcValues;
  6198. end;
  6199. //////////////////////////////////////////////////////////////////////////////////////////////////
  6200. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
  6201. var
  6202. FormatDesc: TFormatDescriptor;
  6203. begin
  6204. result := nil;
  6205. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  6206. FormatDesc := TFormatDescriptor.GetFromMask(aMask);
  6207. if (FormatDesc.Format = tfEmpty) then
  6208. exit;
  6209. aFormat := FormatDesc.Format;
  6210. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  6211. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  6212. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  6213. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  6214. result := TbmpBitfieldFormat.Create;
  6215. result.SetValues(aInfo.biBitCount, aMask);
  6216. end;
  6217. end;
  6218. var
  6219. //simple types
  6220. StartPos: Int64;
  6221. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  6222. PaddingBuff: Cardinal;
  6223. LineBuf, ImageData, TmpData: PByte;
  6224. SourceMD, DestMD: Pointer;
  6225. BmpFormat: TglBitmapFormat;
  6226. //records
  6227. Mask: TglBitmapRec4ul;
  6228. Header: TBMPHeader;
  6229. Info: TBMPInfo;
  6230. //classes
  6231. SpecialFormat: TFormatDescriptor;
  6232. FormatDesc: TFormatDescriptor;
  6233. //////////////////////////////////////////////////////////////////////////////////////////////////
  6234. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  6235. var
  6236. i: Integer;
  6237. Pixel: TglBitmapPixelData;
  6238. begin
  6239. aStream.Read(aLineBuf^, rbLineSize);
  6240. SpecialFormat.PreparePixel(Pixel);
  6241. for i := 0 to Info.biWidth-1 do begin
  6242. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  6243. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  6244. FormatDesc.Map(Pixel, aData, DestMD);
  6245. end;
  6246. end;
  6247. begin
  6248. result := false;
  6249. BmpFormat := tfEmpty;
  6250. SpecialFormat := nil;
  6251. LineBuf := nil;
  6252. SourceMD := nil;
  6253. DestMD := nil;
  6254. // Header
  6255. StartPos := aStream.Position;
  6256. aStream.Read(Header{%H-}, SizeOf(Header));
  6257. if Header.bfType = BMP_MAGIC then begin
  6258. try try
  6259. BmpFormat := ReadInfo(Info, Mask);
  6260. SpecialFormat := ReadColorTable(BmpFormat, Info);
  6261. if not Assigned(SpecialFormat) then
  6262. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  6263. aStream.Position := StartPos + Header.bfOffBits;
  6264. if (BmpFormat <> tfEmpty) then begin
  6265. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  6266. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  6267. wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
  6268. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  6269. //get Memory
  6270. DestMD := FormatDesc.CreateMappingData;
  6271. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  6272. GetMem(ImageData, ImageSize);
  6273. if Assigned(SpecialFormat) then begin
  6274. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  6275. SourceMD := SpecialFormat.CreateMappingData;
  6276. end;
  6277. //read Data
  6278. try try
  6279. FillChar(ImageData^, ImageSize, $FF);
  6280. TmpData := ImageData;
  6281. if (Info.biHeight > 0) then
  6282. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  6283. for i := 0 to Abs(Info.biHeight)-1 do begin
  6284. if Assigned(SpecialFormat) then
  6285. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  6286. else
  6287. aStream.Read(TmpData^, wbLineSize); //else only read data
  6288. if (Info.biHeight > 0) then
  6289. dec(TmpData, wbLineSize)
  6290. else
  6291. inc(TmpData, wbLineSize);
  6292. aStream.Read(PaddingBuff{%H-}, Padding);
  6293. end;
  6294. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6295. result := true;
  6296. finally
  6297. if Assigned(LineBuf) then
  6298. FreeMem(LineBuf);
  6299. if Assigned(SourceMD) then
  6300. SpecialFormat.FreeMappingData(SourceMD);
  6301. FormatDesc.FreeMappingData(DestMD);
  6302. end;
  6303. except
  6304. if Assigned(ImageData) then
  6305. FreeMem(ImageData);
  6306. raise;
  6307. end;
  6308. end else
  6309. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6310. except
  6311. aStream.Position := StartPos;
  6312. raise;
  6313. end;
  6314. finally
  6315. FreeAndNil(SpecialFormat);
  6316. end;
  6317. end
  6318. else aStream.Position := StartPos;
  6319. end;
  6320. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6321. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6322. var
  6323. Header: TBMPHeader;
  6324. Info: TBMPInfo;
  6325. Converter: TFormatDescriptor;
  6326. FormatDesc: TFormatDescriptor;
  6327. SourceFD, DestFD: Pointer;
  6328. pData, srcData, dstData, ConvertBuffer: pByte;
  6329. Pixel: TglBitmapPixelData;
  6330. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6331. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6332. PaddingBuff: Cardinal;
  6333. function GetLineWidth : Integer;
  6334. begin
  6335. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6336. end;
  6337. begin
  6338. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6339. raise EglBitmapUnsupportedFormat.Create(Format);
  6340. Converter := nil;
  6341. FormatDesc := TFormatDescriptor.Get(Format);
  6342. ImageSize := FormatDesc.GetSize(Dimension);
  6343. FillChar(Header{%H-}, SizeOf(Header), 0);
  6344. Header.bfType := BMP_MAGIC;
  6345. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6346. Header.bfReserved1 := 0;
  6347. Header.bfReserved2 := 0;
  6348. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6349. FillChar(Info{%H-}, SizeOf(Info), 0);
  6350. Info.biSize := SizeOf(Info);
  6351. Info.biWidth := Width;
  6352. Info.biHeight := Height;
  6353. Info.biPlanes := 1;
  6354. Info.biCompression := BMP_COMP_RGB;
  6355. Info.biSizeImage := ImageSize;
  6356. try
  6357. case Format of
  6358. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
  6359. begin
  6360. Info.biBitCount := 8;
  6361. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6362. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6363. Converter := TbmpColorTableFormat.Create;
  6364. with (Converter as TbmpColorTableFormat) do begin
  6365. SetValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift);
  6366. CreateColorTable;
  6367. end;
  6368. end;
  6369. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  6370. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  6371. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
  6372. begin
  6373. Info.biBitCount := 16;
  6374. Info.biCompression := BMP_COMP_BITFIELDS;
  6375. end;
  6376. tfBGR8ub3, tfRGB8ub3:
  6377. begin
  6378. Info.biBitCount := 24;
  6379. if (Format = tfRGB8ub3) then
  6380. Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6381. end;
  6382. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  6383. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
  6384. begin
  6385. Info.biBitCount := 32;
  6386. Info.biCompression := BMP_COMP_BITFIELDS;
  6387. end;
  6388. else
  6389. raise EglBitmapUnsupportedFormat.Create(Format);
  6390. end;
  6391. Info.biXPelsPerMeter := 2835;
  6392. Info.biYPelsPerMeter := 2835;
  6393. // prepare bitmasks
  6394. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6395. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6396. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6397. RedMask := FormatDesc.Mask.r;
  6398. GreenMask := FormatDesc.Mask.g;
  6399. BlueMask := FormatDesc.Mask.b;
  6400. AlphaMask := FormatDesc.Mask.a;
  6401. end;
  6402. // headers
  6403. aStream.Write(Header, SizeOf(Header));
  6404. aStream.Write(Info, SizeOf(Info));
  6405. // colortable
  6406. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6407. with (Converter as TbmpColorTableFormat) do
  6408. aStream.Write(ColorTable[0].b,
  6409. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6410. // bitmasks
  6411. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6412. aStream.Write(RedMask, SizeOf(Cardinal));
  6413. aStream.Write(GreenMask, SizeOf(Cardinal));
  6414. aStream.Write(BlueMask, SizeOf(Cardinal));
  6415. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6416. end;
  6417. // image data
  6418. rbLineSize := Round(Info.biWidth * FormatDesc.BytesPerPixel);
  6419. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6420. Padding := GetLineWidth - wbLineSize;
  6421. PaddingBuff := 0;
  6422. pData := Data;
  6423. inc(pData, (Height-1) * rbLineSize);
  6424. // prepare row buffer. But only for RGB because RGBA supports color masks
  6425. // so it's possible to change color within the image.
  6426. if Assigned(Converter) then begin
  6427. FormatDesc.PreparePixel(Pixel);
  6428. GetMem(ConvertBuffer, wbLineSize);
  6429. SourceFD := FormatDesc.CreateMappingData;
  6430. DestFD := Converter.CreateMappingData;
  6431. end else
  6432. ConvertBuffer := nil;
  6433. try
  6434. for LineIdx := 0 to Height - 1 do begin
  6435. // preparing row
  6436. if Assigned(Converter) then begin
  6437. srcData := pData;
  6438. dstData := ConvertBuffer;
  6439. for PixelIdx := 0 to Info.biWidth-1 do begin
  6440. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6441. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6442. Converter.Map(Pixel, dstData, DestFD);
  6443. end;
  6444. aStream.Write(ConvertBuffer^, wbLineSize);
  6445. end else begin
  6446. aStream.Write(pData^, rbLineSize);
  6447. end;
  6448. dec(pData, rbLineSize);
  6449. if (Padding > 0) then
  6450. aStream.Write(PaddingBuff, Padding);
  6451. end;
  6452. finally
  6453. // destroy row buffer
  6454. if Assigned(ConvertBuffer) then begin
  6455. FormatDesc.FreeMappingData(SourceFD);
  6456. Converter.FreeMappingData(DestFD);
  6457. FreeMem(ConvertBuffer);
  6458. end;
  6459. end;
  6460. finally
  6461. if Assigned(Converter) then
  6462. Converter.Free;
  6463. end;
  6464. end;
  6465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6466. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6467. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6468. type
  6469. TTGAHeader = packed record
  6470. ImageID: Byte;
  6471. ColorMapType: Byte;
  6472. ImageType: Byte;
  6473. //ColorMapSpec: Array[0..4] of Byte;
  6474. ColorMapStart: Word;
  6475. ColorMapLength: Word;
  6476. ColorMapEntrySize: Byte;
  6477. OrigX: Word;
  6478. OrigY: Word;
  6479. Width: Word;
  6480. Height: Word;
  6481. Bpp: Byte;
  6482. ImageDesc: Byte;
  6483. end;
  6484. const
  6485. TGA_UNCOMPRESSED_RGB = 2;
  6486. TGA_UNCOMPRESSED_GRAY = 3;
  6487. TGA_COMPRESSED_RGB = 10;
  6488. TGA_COMPRESSED_GRAY = 11;
  6489. TGA_NONE_COLOR_TABLE = 0;
  6490. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6491. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6492. var
  6493. Header: TTGAHeader;
  6494. ImageData: System.PByte;
  6495. StartPosition: Int64;
  6496. PixelSize, LineSize: Integer;
  6497. tgaFormat: TglBitmapFormat;
  6498. FormatDesc: TFormatDescriptor;
  6499. Counter: packed record
  6500. X, Y: packed record
  6501. low, high, dir: Integer;
  6502. end;
  6503. end;
  6504. const
  6505. CACHE_SIZE = $4000;
  6506. ////////////////////////////////////////////////////////////////////////////////////////
  6507. procedure ReadUncompressed;
  6508. var
  6509. i, j: Integer;
  6510. buf, tmp1, tmp2: System.PByte;
  6511. begin
  6512. buf := nil;
  6513. if (Counter.X.dir < 0) then
  6514. GetMem(buf, LineSize);
  6515. try
  6516. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6517. tmp1 := ImageData;
  6518. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6519. if (Counter.X.dir < 0) then begin //flip X
  6520. aStream.Read(buf^, LineSize);
  6521. tmp2 := buf;
  6522. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6523. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6524. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6525. tmp1^ := tmp2^;
  6526. inc(tmp1);
  6527. inc(tmp2);
  6528. end;
  6529. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6530. end;
  6531. end else
  6532. aStream.Read(tmp1^, LineSize);
  6533. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6534. end;
  6535. finally
  6536. if Assigned(buf) then
  6537. FreeMem(buf);
  6538. end;
  6539. end;
  6540. ////////////////////////////////////////////////////////////////////////////////////////
  6541. procedure ReadCompressed;
  6542. /////////////////////////////////////////////////////////////////
  6543. var
  6544. TmpData: System.PByte;
  6545. LinePixelsRead: Integer;
  6546. procedure CheckLine;
  6547. begin
  6548. if (LinePixelsRead >= Header.Width) then begin
  6549. LinePixelsRead := 0;
  6550. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6551. TmpData := ImageData;
  6552. inc(TmpData, Counter.Y.low * LineSize); //set line
  6553. if (Counter.X.dir < 0) then //if x flipped then
  6554. inc(TmpData, LineSize - PixelSize); //set last pixel
  6555. end;
  6556. end;
  6557. /////////////////////////////////////////////////////////////////
  6558. var
  6559. Cache: PByte;
  6560. CacheSize, CachePos: Integer;
  6561. procedure CachedRead(out Buffer; Count: Integer);
  6562. var
  6563. BytesRead: Integer;
  6564. begin
  6565. if (CachePos + Count > CacheSize) then begin
  6566. //if buffer overflow save non read bytes
  6567. BytesRead := 0;
  6568. if (CacheSize - CachePos > 0) then begin
  6569. BytesRead := CacheSize - CachePos;
  6570. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6571. inc(CachePos, BytesRead);
  6572. end;
  6573. //load cache from file
  6574. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6575. aStream.Read(Cache^, CacheSize);
  6576. CachePos := 0;
  6577. //read rest of requested bytes
  6578. if (Count - BytesRead > 0) then begin
  6579. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6580. inc(CachePos, Count - BytesRead);
  6581. end;
  6582. end else begin
  6583. //if no buffer overflow just read the data
  6584. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6585. inc(CachePos, Count);
  6586. end;
  6587. end;
  6588. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6589. begin
  6590. case PixelSize of
  6591. 1: begin
  6592. aBuffer^ := aData^;
  6593. inc(aBuffer, Counter.X.dir);
  6594. end;
  6595. 2: begin
  6596. PWord(aBuffer)^ := PWord(aData)^;
  6597. inc(aBuffer, 2 * Counter.X.dir);
  6598. end;
  6599. 3: begin
  6600. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6601. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6602. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6603. inc(aBuffer, 3 * Counter.X.dir);
  6604. end;
  6605. 4: begin
  6606. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6607. inc(aBuffer, 4 * Counter.X.dir);
  6608. end;
  6609. end;
  6610. end;
  6611. var
  6612. TotalPixelsToRead, TotalPixelsRead: Integer;
  6613. Temp: Byte;
  6614. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6615. PixelRepeat: Boolean;
  6616. PixelsToRead, PixelCount: Integer;
  6617. begin
  6618. CacheSize := 0;
  6619. CachePos := 0;
  6620. TotalPixelsToRead := Header.Width * Header.Height;
  6621. TotalPixelsRead := 0;
  6622. LinePixelsRead := 0;
  6623. GetMem(Cache, CACHE_SIZE);
  6624. try
  6625. TmpData := ImageData;
  6626. inc(TmpData, Counter.Y.low * LineSize); //set line
  6627. if (Counter.X.dir < 0) then //if x flipped then
  6628. inc(TmpData, LineSize - PixelSize); //set last pixel
  6629. repeat
  6630. //read CommandByte
  6631. CachedRead(Temp, 1);
  6632. PixelRepeat := (Temp and $80) > 0;
  6633. PixelsToRead := (Temp and $7F) + 1;
  6634. inc(TotalPixelsRead, PixelsToRead);
  6635. if PixelRepeat then
  6636. CachedRead(buf[0], PixelSize);
  6637. while (PixelsToRead > 0) do begin
  6638. CheckLine;
  6639. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6640. while (PixelCount > 0) do begin
  6641. if not PixelRepeat then
  6642. CachedRead(buf[0], PixelSize);
  6643. PixelToBuffer(@buf[0], TmpData);
  6644. inc(LinePixelsRead);
  6645. dec(PixelsToRead);
  6646. dec(PixelCount);
  6647. end;
  6648. end;
  6649. until (TotalPixelsRead >= TotalPixelsToRead);
  6650. finally
  6651. FreeMem(Cache);
  6652. end;
  6653. end;
  6654. function IsGrayFormat: Boolean;
  6655. begin
  6656. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6657. end;
  6658. begin
  6659. result := false;
  6660. // reading header to test file and set cursor back to begin
  6661. StartPosition := aStream.Position;
  6662. aStream.Read(Header{%H-}, SizeOf(Header));
  6663. // no colormapped files
  6664. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6665. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6666. begin
  6667. try
  6668. if Header.ImageID <> 0 then // skip image ID
  6669. aStream.Position := aStream.Position + Header.ImageID;
  6670. tgaFormat := tfEmpty;
  6671. case Header.Bpp of
  6672. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6673. 0: tgaFormat := tfLuminance8ub1;
  6674. 8: tgaFormat := tfAlpha8ub1;
  6675. end;
  6676. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6677. 0: tgaFormat := tfLuminance16us1;
  6678. 8: tgaFormat := tfLuminance8Alpha8ub2;
  6679. end else case (Header.ImageDesc and $F) of
  6680. 0: tgaFormat := tfX1RGB5us1;
  6681. 1: tgaFormat := tfA1RGB5us1;
  6682. 4: tgaFormat := tfARGB4us1;
  6683. end;
  6684. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6685. 0: tgaFormat := tfBGR8ub3;
  6686. end;
  6687. 32: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6688. 0: tgaFormat := tfDepth32ui1;
  6689. end else case (Header.ImageDesc and $F) of
  6690. 0: tgaFormat := tfX2RGB10ui1;
  6691. 2: tgaFormat := tfA2RGB10ui1;
  6692. 8: tgaFormat := tfARGB8ui1;
  6693. end;
  6694. end;
  6695. if (tgaFormat = tfEmpty) then
  6696. raise EglBitmap.Create('LoadTga - unsupported format');
  6697. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6698. PixelSize := FormatDesc.GetSize(1, 1);
  6699. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6700. GetMem(ImageData, LineSize * Header.Height);
  6701. try
  6702. //column direction
  6703. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6704. Counter.X.low := Header.Height-1;;
  6705. Counter.X.high := 0;
  6706. Counter.X.dir := -1;
  6707. end else begin
  6708. Counter.X.low := 0;
  6709. Counter.X.high := Header.Height-1;
  6710. Counter.X.dir := 1;
  6711. end;
  6712. // Row direction
  6713. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6714. Counter.Y.low := 0;
  6715. Counter.Y.high := Header.Height-1;
  6716. Counter.Y.dir := 1;
  6717. end else begin
  6718. Counter.Y.low := Header.Height-1;;
  6719. Counter.Y.high := 0;
  6720. Counter.Y.dir := -1;
  6721. end;
  6722. // Read Image
  6723. case Header.ImageType of
  6724. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6725. ReadUncompressed;
  6726. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6727. ReadCompressed;
  6728. end;
  6729. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6730. result := true;
  6731. except
  6732. if Assigned(ImageData) then
  6733. FreeMem(ImageData);
  6734. raise;
  6735. end;
  6736. finally
  6737. aStream.Position := StartPosition;
  6738. end;
  6739. end
  6740. else aStream.Position := StartPosition;
  6741. end;
  6742. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6743. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6744. var
  6745. Header: TTGAHeader;
  6746. Size: Integer;
  6747. FormatDesc: TFormatDescriptor;
  6748. begin
  6749. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6750. raise EglBitmapUnsupportedFormat.Create(Format);
  6751. //prepare header
  6752. FormatDesc := TFormatDescriptor.Get(Format);
  6753. FillChar(Header{%H-}, SizeOf(Header), 0);
  6754. Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
  6755. Header.Bpp := FormatDesc.BitsPerPixel;
  6756. Header.Width := Width;
  6757. Header.Height := Height;
  6758. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6759. if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
  6760. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6761. else
  6762. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6763. aStream.Write(Header, SizeOf(Header));
  6764. // write Data
  6765. Size := FormatDesc.GetSize(Dimension);
  6766. aStream.Write(Data^, Size);
  6767. end;
  6768. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6769. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6770. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6771. const
  6772. DDS_MAGIC: Cardinal = $20534444;
  6773. // DDS_header.dwFlags
  6774. DDSD_CAPS = $00000001;
  6775. DDSD_HEIGHT = $00000002;
  6776. DDSD_WIDTH = $00000004;
  6777. DDSD_PIXELFORMAT = $00001000;
  6778. // DDS_header.sPixelFormat.dwFlags
  6779. DDPF_ALPHAPIXELS = $00000001;
  6780. DDPF_ALPHA = $00000002;
  6781. DDPF_FOURCC = $00000004;
  6782. DDPF_RGB = $00000040;
  6783. DDPF_LUMINANCE = $00020000;
  6784. // DDS_header.sCaps.dwCaps1
  6785. DDSCAPS_TEXTURE = $00001000;
  6786. // DDS_header.sCaps.dwCaps2
  6787. DDSCAPS2_CUBEMAP = $00000200;
  6788. D3DFMT_DXT1 = $31545844;
  6789. D3DFMT_DXT3 = $33545844;
  6790. D3DFMT_DXT5 = $35545844;
  6791. type
  6792. TDDSPixelFormat = packed record
  6793. dwSize: Cardinal;
  6794. dwFlags: Cardinal;
  6795. dwFourCC: Cardinal;
  6796. dwRGBBitCount: Cardinal;
  6797. dwRBitMask: Cardinal;
  6798. dwGBitMask: Cardinal;
  6799. dwBBitMask: Cardinal;
  6800. dwABitMask: Cardinal;
  6801. end;
  6802. TDDSCaps = packed record
  6803. dwCaps1: Cardinal;
  6804. dwCaps2: Cardinal;
  6805. dwDDSX: Cardinal;
  6806. dwReserved: Cardinal;
  6807. end;
  6808. TDDSHeader = packed record
  6809. dwSize: Cardinal;
  6810. dwFlags: Cardinal;
  6811. dwHeight: Cardinal;
  6812. dwWidth: Cardinal;
  6813. dwPitchOrLinearSize: Cardinal;
  6814. dwDepth: Cardinal;
  6815. dwMipMapCount: Cardinal;
  6816. dwReserved: array[0..10] of Cardinal;
  6817. PixelFormat: TDDSPixelFormat;
  6818. Caps: TDDSCaps;
  6819. dwReserved2: Cardinal;
  6820. end;
  6821. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6822. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6823. var
  6824. Header: TDDSHeader;
  6825. Converter: TbmpBitfieldFormat;
  6826. function GetDDSFormat: TglBitmapFormat;
  6827. var
  6828. fd: TFormatDescriptor;
  6829. i: Integer;
  6830. Mask: TglBitmapRec4ul;
  6831. Range: TglBitmapRec4ui;
  6832. match: Boolean;
  6833. begin
  6834. result := tfEmpty;
  6835. with Header.PixelFormat do begin
  6836. // Compresses
  6837. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6838. case Header.PixelFormat.dwFourCC of
  6839. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6840. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6841. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6842. end;
  6843. end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
  6844. // prepare masks
  6845. if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
  6846. Mask.r := dwRBitMask;
  6847. Mask.g := dwGBitMask;
  6848. Mask.b := dwBBitMask;
  6849. end else begin
  6850. Mask.r := dwRBitMask;
  6851. Mask.g := dwRBitMask;
  6852. Mask.b := dwRBitMask;
  6853. end;
  6854. if (dwFlags and DDPF_ALPHAPIXELS > 0) then
  6855. Mask.a := dwABitMask
  6856. else
  6857. Mask.a := 0;;
  6858. //find matching format
  6859. fd := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
  6860. result := fd.Format;
  6861. if (result <> tfEmpty) then
  6862. exit;
  6863. //find format with same Range
  6864. for i := 0 to 3 do
  6865. Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
  6866. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6867. fd := TFormatDescriptor.Get(result);
  6868. match := true;
  6869. for i := 0 to 3 do
  6870. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6871. match := false;
  6872. break;
  6873. end;
  6874. if match then
  6875. break;
  6876. end;
  6877. //no format with same range found -> use default
  6878. if (result = tfEmpty) then begin
  6879. if (dwABitMask > 0) then
  6880. result := tfRGBA8ui1
  6881. else
  6882. result := tfRGB8ub3;
  6883. end;
  6884. Converter := TbmpBitfieldFormat.Create;
  6885. Converter.SetValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
  6886. end;
  6887. end;
  6888. end;
  6889. var
  6890. StreamPos: Int64;
  6891. x, y, LineSize, RowSize, Magic: Cardinal;
  6892. NewImage, TmpData, RowData, SrcData: System.PByte;
  6893. SourceMD, DestMD: Pointer;
  6894. Pixel: TglBitmapPixelData;
  6895. ddsFormat: TglBitmapFormat;
  6896. FormatDesc: TFormatDescriptor;
  6897. begin
  6898. result := false;
  6899. Converter := nil;
  6900. StreamPos := aStream.Position;
  6901. // Magic
  6902. aStream.Read(Magic{%H-}, sizeof(Magic));
  6903. if (Magic <> DDS_MAGIC) then begin
  6904. aStream.Position := StreamPos;
  6905. exit;
  6906. end;
  6907. //Header
  6908. aStream.Read(Header{%H-}, sizeof(Header));
  6909. if (Header.dwSize <> SizeOf(Header)) or
  6910. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6911. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6912. begin
  6913. aStream.Position := StreamPos;
  6914. exit;
  6915. end;
  6916. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6917. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  6918. ddsFormat := GetDDSFormat;
  6919. try
  6920. if (ddsFormat = tfEmpty) then
  6921. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6922. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6923. LineSize := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
  6924. GetMem(NewImage, Header.dwHeight * LineSize);
  6925. try
  6926. TmpData := NewImage;
  6927. //Converter needed
  6928. if Assigned(Converter) then begin
  6929. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6930. GetMem(RowData, RowSize);
  6931. SourceMD := Converter.CreateMappingData;
  6932. DestMD := FormatDesc.CreateMappingData;
  6933. try
  6934. for y := 0 to Header.dwHeight-1 do begin
  6935. TmpData := NewImage;
  6936. inc(TmpData, y * LineSize);
  6937. SrcData := RowData;
  6938. aStream.Read(SrcData^, RowSize);
  6939. for x := 0 to Header.dwWidth-1 do begin
  6940. Converter.Unmap(SrcData, Pixel, SourceMD);
  6941. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6942. FormatDesc.Map(Pixel, TmpData, DestMD);
  6943. end;
  6944. end;
  6945. finally
  6946. Converter.FreeMappingData(SourceMD);
  6947. FormatDesc.FreeMappingData(DestMD);
  6948. FreeMem(RowData);
  6949. end;
  6950. end else
  6951. // Compressed
  6952. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6953. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6954. for Y := 0 to Header.dwHeight-1 do begin
  6955. aStream.Read(TmpData^, RowSize);
  6956. Inc(TmpData, LineSize);
  6957. end;
  6958. end else
  6959. // Uncompressed
  6960. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6961. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6962. for Y := 0 to Header.dwHeight-1 do begin
  6963. aStream.Read(TmpData^, RowSize);
  6964. Inc(TmpData, LineSize);
  6965. end;
  6966. end else
  6967. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6968. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  6969. result := true;
  6970. except
  6971. if Assigned(NewImage) then
  6972. FreeMem(NewImage);
  6973. raise;
  6974. end;
  6975. finally
  6976. FreeAndNil(Converter);
  6977. end;
  6978. end;
  6979. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6980. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6981. var
  6982. Header: TDDSHeader;
  6983. FormatDesc: TFormatDescriptor;
  6984. begin
  6985. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6986. raise EglBitmapUnsupportedFormat.Create(Format);
  6987. FormatDesc := TFormatDescriptor.Get(Format);
  6988. // Generell
  6989. FillChar(Header{%H-}, SizeOf(Header), 0);
  6990. Header.dwSize := SizeOf(Header);
  6991. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6992. Header.dwWidth := Max(1, Width);
  6993. Header.dwHeight := Max(1, Height);
  6994. // Caps
  6995. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6996. // Pixelformat
  6997. Header.PixelFormat.dwSize := sizeof(Header);
  6998. if (FormatDesc.IsCompressed) then begin
  6999. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  7000. case Format of
  7001. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  7002. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  7003. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  7004. end;
  7005. end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
  7006. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  7007. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7008. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7009. end else if FormatDesc.IsGrayscale then begin
  7010. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  7011. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7012. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  7013. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7014. end else begin
  7015. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  7016. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  7017. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  7018. Header.PixelFormat.dwGBitMask := FormatDesc.Mask.g;
  7019. Header.PixelFormat.dwBBitMask := FormatDesc.Mask.b;
  7020. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  7021. end;
  7022. if (FormatDesc.HasAlpha) then
  7023. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  7024. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  7025. aStream.Write(Header, SizeOf(Header));
  7026. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  7027. end;
  7028. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7029. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7030. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7031. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7032. const aWidth: Integer; const aHeight: Integer);
  7033. var
  7034. pTemp: pByte;
  7035. Size: Integer;
  7036. begin
  7037. if (aHeight > 1) then begin
  7038. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  7039. GetMem(pTemp, Size);
  7040. try
  7041. Move(aData^, pTemp^, Size);
  7042. FreeMem(aData);
  7043. aData := nil;
  7044. except
  7045. FreeMem(pTemp);
  7046. raise;
  7047. end;
  7048. end else
  7049. pTemp := aData;
  7050. inherited SetDataPointer(pTemp, aFormat, aWidth);
  7051. end;
  7052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7053. function TglBitmap1D.FlipHorz: Boolean;
  7054. var
  7055. Col: Integer;
  7056. pTempDest, pDest, pSource: PByte;
  7057. begin
  7058. result := inherited FlipHorz;
  7059. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  7060. pSource := Data;
  7061. GetMem(pDest, fRowSize);
  7062. try
  7063. pTempDest := pDest;
  7064. Inc(pTempDest, fRowSize);
  7065. for Col := 0 to Width-1 do begin
  7066. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  7067. Move(pSource^, pTempDest^, fPixelSize);
  7068. Inc(pSource, fPixelSize);
  7069. end;
  7070. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  7071. result := true;
  7072. except
  7073. if Assigned(pDest) then
  7074. FreeMem(pDest);
  7075. raise;
  7076. end;
  7077. end;
  7078. end;
  7079. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7080. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  7081. var
  7082. FormatDesc: TFormatDescriptor;
  7083. begin
  7084. // Upload data
  7085. FormatDesc := TFormatDescriptor.Get(Format);
  7086. if FormatDesc.IsCompressed then begin
  7087. if not Assigned(glCompressedTexImage1D) then
  7088. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7089. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  7090. end else if aBuildWithGlu then
  7091. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7092. else
  7093. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7094. // Free Data
  7095. if (FreeDataAfterGenTexture) then
  7096. FreeData;
  7097. end;
  7098. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7099. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  7100. var
  7101. BuildWithGlu, TexRec: Boolean;
  7102. TexSize: Integer;
  7103. begin
  7104. if Assigned(Data) then begin
  7105. // Check Texture Size
  7106. if (aTestTextureSize) then begin
  7107. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7108. if (Width > TexSize) then
  7109. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7110. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7111. (Target = GL_TEXTURE_RECTANGLE);
  7112. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7113. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7114. end;
  7115. CreateId;
  7116. SetupParameters(BuildWithGlu);
  7117. UploadData(BuildWithGlu);
  7118. glAreTexturesResident(1, @fID, @fIsResident);
  7119. end;
  7120. end;
  7121. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7122. procedure TglBitmap1D.AfterConstruction;
  7123. begin
  7124. inherited;
  7125. Target := GL_TEXTURE_1D;
  7126. end;
  7127. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7128. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7129. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7130. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  7131. begin
  7132. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  7133. result := fLines[aIndex]
  7134. else
  7135. result := nil;
  7136. end;
  7137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7138. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7139. const aWidth: Integer; const aHeight: Integer);
  7140. var
  7141. Idx, LineWidth: Integer;
  7142. begin
  7143. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  7144. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  7145. // Assigning Data
  7146. if Assigned(Data) then begin
  7147. SetLength(fLines, GetHeight);
  7148. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel);
  7149. for Idx := 0 to GetHeight-1 do begin
  7150. fLines[Idx] := Data;
  7151. Inc(fLines[Idx], Idx * LineWidth);
  7152. end;
  7153. end
  7154. else SetLength(fLines, 0);
  7155. end else begin
  7156. SetLength(fLines, 0);
  7157. end;
  7158. end;
  7159. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7160. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  7161. var
  7162. FormatDesc: TFormatDescriptor;
  7163. begin
  7164. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7165. FormatDesc := TFormatDescriptor.Get(Format);
  7166. if FormatDesc.IsCompressed then begin
  7167. if not Assigned(glCompressedTexImage2D) then
  7168. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7169. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  7170. end else if aBuildWithGlu then begin
  7171. gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height,
  7172. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7173. end else begin
  7174. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  7175. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7176. end;
  7177. // Freigeben
  7178. if (FreeDataAfterGenTexture) then
  7179. FreeData;
  7180. end;
  7181. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7182. procedure TglBitmap2D.AfterConstruction;
  7183. begin
  7184. inherited;
  7185. Target := GL_TEXTURE_2D;
  7186. end;
  7187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7188. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  7189. var
  7190. Temp: pByte;
  7191. Size, w, h: Integer;
  7192. FormatDesc: TFormatDescriptor;
  7193. begin
  7194. FormatDesc := TFormatDescriptor.Get(aFormat);
  7195. if FormatDesc.IsCompressed then
  7196. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7197. w := aRight - aLeft;
  7198. h := aBottom - aTop;
  7199. Size := FormatDesc.GetSize(w, h);
  7200. GetMem(Temp, Size);
  7201. try
  7202. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7203. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7204. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  7205. FlipVert;
  7206. except
  7207. if Assigned(Temp) then
  7208. FreeMem(Temp);
  7209. raise;
  7210. end;
  7211. end;
  7212. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7213. procedure TglBitmap2D.GetDataFromTexture;
  7214. var
  7215. Temp: PByte;
  7216. TempWidth, TempHeight: Integer;
  7217. TempIntFormat: GLint;
  7218. IntFormat: TglBitmapFormat;
  7219. FormatDesc: TFormatDescriptor;
  7220. begin
  7221. Bind;
  7222. // Request Data
  7223. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7224. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7225. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7226. IntFormat := tfEmpty;
  7227. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7228. IntFormat := FormatDesc.Format;
  7229. // Getting data from OpenGL
  7230. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7231. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7232. try
  7233. if FormatDesc.IsCompressed then begin
  7234. if not Assigned(glGetCompressedTexImage) then
  7235. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7236. glGetCompressedTexImage(Target, 0, Temp)
  7237. end else
  7238. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7239. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7240. except
  7241. if Assigned(Temp) then
  7242. FreeMem(Temp);
  7243. raise;
  7244. end;
  7245. end;
  7246. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7247. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7248. var
  7249. BuildWithGlu, PotTex, TexRec: Boolean;
  7250. TexSize: Integer;
  7251. begin
  7252. if Assigned(Data) then begin
  7253. // Check Texture Size
  7254. if (aTestTextureSize) then begin
  7255. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7256. if ((Height > TexSize) or (Width > TexSize)) then
  7257. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7258. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7259. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7260. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7261. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7262. end;
  7263. CreateId;
  7264. SetupParameters(BuildWithGlu);
  7265. UploadData(Target, BuildWithGlu);
  7266. glAreTexturesResident(1, @fID, @fIsResident);
  7267. end;
  7268. end;
  7269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7270. function TglBitmap2D.FlipHorz: Boolean;
  7271. var
  7272. Col, Row: Integer;
  7273. TempDestData, DestData, SourceData: PByte;
  7274. ImgSize: Integer;
  7275. begin
  7276. result := inherited FlipHorz;
  7277. if Assigned(Data) then begin
  7278. SourceData := Data;
  7279. ImgSize := Height * fRowSize;
  7280. GetMem(DestData, ImgSize);
  7281. try
  7282. TempDestData := DestData;
  7283. Dec(TempDestData, fRowSize + fPixelSize);
  7284. for Row := 0 to Height -1 do begin
  7285. Inc(TempDestData, fRowSize * 2);
  7286. for Col := 0 to Width -1 do begin
  7287. Move(SourceData^, TempDestData^, fPixelSize);
  7288. Inc(SourceData, fPixelSize);
  7289. Dec(TempDestData, fPixelSize);
  7290. end;
  7291. end;
  7292. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7293. result := true;
  7294. except
  7295. if Assigned(DestData) then
  7296. FreeMem(DestData);
  7297. raise;
  7298. end;
  7299. end;
  7300. end;
  7301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7302. function TglBitmap2D.FlipVert: Boolean;
  7303. var
  7304. Row: Integer;
  7305. TempDestData, DestData, SourceData: PByte;
  7306. begin
  7307. result := inherited FlipVert;
  7308. if Assigned(Data) then begin
  7309. SourceData := Data;
  7310. GetMem(DestData, Height * fRowSize);
  7311. try
  7312. TempDestData := DestData;
  7313. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7314. for Row := 0 to Height -1 do begin
  7315. Move(SourceData^, TempDestData^, fRowSize);
  7316. Dec(TempDestData, fRowSize);
  7317. Inc(SourceData, fRowSize);
  7318. end;
  7319. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7320. result := true;
  7321. except
  7322. if Assigned(DestData) then
  7323. FreeMem(DestData);
  7324. raise;
  7325. end;
  7326. end;
  7327. end;
  7328. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7329. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7330. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7331. type
  7332. TMatrixItem = record
  7333. X, Y: Integer;
  7334. W: Single;
  7335. end;
  7336. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7337. TglBitmapToNormalMapRec = Record
  7338. Scale: Single;
  7339. Heights: array of Single;
  7340. MatrixU : array of TMatrixItem;
  7341. MatrixV : array of TMatrixItem;
  7342. end;
  7343. const
  7344. ONE_OVER_255 = 1 / 255;
  7345. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7346. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7347. var
  7348. Val: Single;
  7349. begin
  7350. with FuncRec do begin
  7351. Val :=
  7352. Source.Data.r * LUMINANCE_WEIGHT_R +
  7353. Source.Data.g * LUMINANCE_WEIGHT_G +
  7354. Source.Data.b * LUMINANCE_WEIGHT_B;
  7355. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7356. end;
  7357. end;
  7358. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7359. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7360. begin
  7361. with FuncRec do
  7362. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7363. end;
  7364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7365. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7366. type
  7367. TVec = Array[0..2] of Single;
  7368. var
  7369. Idx: Integer;
  7370. du, dv: Double;
  7371. Len: Single;
  7372. Vec: TVec;
  7373. function GetHeight(X, Y: Integer): Single;
  7374. begin
  7375. with FuncRec do begin
  7376. X := Max(0, Min(Size.X -1, X));
  7377. Y := Max(0, Min(Size.Y -1, Y));
  7378. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7379. end;
  7380. end;
  7381. begin
  7382. with FuncRec do begin
  7383. with PglBitmapToNormalMapRec(Args)^ do begin
  7384. du := 0;
  7385. for Idx := Low(MatrixU) to High(MatrixU) do
  7386. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7387. dv := 0;
  7388. for Idx := Low(MatrixU) to High(MatrixU) do
  7389. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7390. Vec[0] := -du * Scale;
  7391. Vec[1] := -dv * Scale;
  7392. Vec[2] := 1;
  7393. end;
  7394. // Normalize
  7395. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7396. if Len <> 0 then begin
  7397. Vec[0] := Vec[0] * Len;
  7398. Vec[1] := Vec[1] * Len;
  7399. Vec[2] := Vec[2] * Len;
  7400. end;
  7401. // Farbe zuweisem
  7402. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7403. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7404. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7405. end;
  7406. end;
  7407. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7408. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7409. var
  7410. Rec: TglBitmapToNormalMapRec;
  7411. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7412. begin
  7413. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7414. Matrix[Index].X := X;
  7415. Matrix[Index].Y := Y;
  7416. Matrix[Index].W := W;
  7417. end;
  7418. end;
  7419. begin
  7420. if TFormatDescriptor.Get(Format).IsCompressed then
  7421. raise EglBitmapUnsupportedFormat.Create(Format);
  7422. if aScale > 100 then
  7423. Rec.Scale := 100
  7424. else if aScale < -100 then
  7425. Rec.Scale := -100
  7426. else
  7427. Rec.Scale := aScale;
  7428. SetLength(Rec.Heights, Width * Height);
  7429. try
  7430. case aFunc of
  7431. nm4Samples: begin
  7432. SetLength(Rec.MatrixU, 2);
  7433. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7434. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7435. SetLength(Rec.MatrixV, 2);
  7436. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7437. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7438. end;
  7439. nmSobel: begin
  7440. SetLength(Rec.MatrixU, 6);
  7441. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7442. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7443. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7444. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7445. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7446. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7447. SetLength(Rec.MatrixV, 6);
  7448. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7449. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7450. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7451. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7452. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7453. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7454. end;
  7455. nm3x3: begin
  7456. SetLength(Rec.MatrixU, 6);
  7457. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7458. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7459. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7460. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7461. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7462. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7463. SetLength(Rec.MatrixV, 6);
  7464. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7465. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7466. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7467. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7468. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7469. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7470. end;
  7471. nm5x5: begin
  7472. SetLength(Rec.MatrixU, 20);
  7473. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7474. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7475. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7476. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7477. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7478. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7479. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7480. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7481. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7482. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7483. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7484. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7485. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7486. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7487. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7488. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7489. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7490. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7491. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7492. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7493. SetLength(Rec.MatrixV, 20);
  7494. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7495. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7496. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7497. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7498. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7499. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7500. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7501. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7502. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7503. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7504. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7505. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7506. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7507. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7508. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7509. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7510. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7511. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7512. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7513. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7514. end;
  7515. end;
  7516. // Daten Sammeln
  7517. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7518. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7519. else
  7520. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7521. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7522. finally
  7523. SetLength(Rec.Heights, 0);
  7524. end;
  7525. end;
  7526. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7527. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7528. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7529. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7530. begin
  7531. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7532. end;
  7533. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7534. procedure TglBitmapCubeMap.AfterConstruction;
  7535. begin
  7536. inherited;
  7537. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7538. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7539. SetWrap;
  7540. Target := GL_TEXTURE_CUBE_MAP;
  7541. fGenMode := GL_REFLECTION_MAP;
  7542. end;
  7543. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7544. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7545. var
  7546. BuildWithGlu: Boolean;
  7547. TexSize: Integer;
  7548. begin
  7549. if (aTestTextureSize) then begin
  7550. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7551. if (Height > TexSize) or (Width > TexSize) then
  7552. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7553. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7554. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7555. end;
  7556. if (ID = 0) then
  7557. CreateID;
  7558. SetupParameters(BuildWithGlu);
  7559. UploadData(aCubeTarget, BuildWithGlu);
  7560. end;
  7561. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7562. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
  7563. begin
  7564. inherited Bind (aEnableTextureUnit);
  7565. if aEnableTexCoordsGen then begin
  7566. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7567. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7568. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7569. glEnable(GL_TEXTURE_GEN_S);
  7570. glEnable(GL_TEXTURE_GEN_T);
  7571. glEnable(GL_TEXTURE_GEN_R);
  7572. end;
  7573. end;
  7574. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7575. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
  7576. begin
  7577. inherited Unbind(aDisableTextureUnit);
  7578. if aDisableTexCoordsGen then begin
  7579. glDisable(GL_TEXTURE_GEN_S);
  7580. glDisable(GL_TEXTURE_GEN_T);
  7581. glDisable(GL_TEXTURE_GEN_R);
  7582. end;
  7583. end;
  7584. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7585. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7586. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7587. type
  7588. TVec = Array[0..2] of Single;
  7589. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7590. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7591. TglBitmapNormalMapRec = record
  7592. HalfSize : Integer;
  7593. Func: TglBitmapNormalMapGetVectorFunc;
  7594. end;
  7595. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7596. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7597. begin
  7598. aVec[0] := aHalfSize;
  7599. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7600. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7601. end;
  7602. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7603. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7604. begin
  7605. aVec[0] := - aHalfSize;
  7606. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7607. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7608. end;
  7609. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7610. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7611. begin
  7612. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7613. aVec[1] := aHalfSize;
  7614. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7615. end;
  7616. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7617. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7618. begin
  7619. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7620. aVec[1] := - aHalfSize;
  7621. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7622. end;
  7623. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7624. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7625. begin
  7626. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7627. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7628. aVec[2] := aHalfSize;
  7629. end;
  7630. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7631. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7632. begin
  7633. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7634. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7635. aVec[2] := - aHalfSize;
  7636. end;
  7637. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7638. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7639. var
  7640. i: Integer;
  7641. Vec: TVec;
  7642. Len: Single;
  7643. begin
  7644. with FuncRec do begin
  7645. with PglBitmapNormalMapRec(Args)^ do begin
  7646. Func(Vec, Position, HalfSize);
  7647. // Normalize
  7648. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7649. if Len <> 0 then begin
  7650. Vec[0] := Vec[0] * Len;
  7651. Vec[1] := Vec[1] * Len;
  7652. Vec[2] := Vec[2] * Len;
  7653. end;
  7654. // Scale Vector and AddVectro
  7655. Vec[0] := Vec[0] * 0.5 + 0.5;
  7656. Vec[1] := Vec[1] * 0.5 + 0.5;
  7657. Vec[2] := Vec[2] * 0.5 + 0.5;
  7658. end;
  7659. // Set Color
  7660. for i := 0 to 2 do
  7661. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7662. end;
  7663. end;
  7664. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7665. procedure TglBitmapNormalMap.AfterConstruction;
  7666. begin
  7667. inherited;
  7668. fGenMode := GL_NORMAL_MAP;
  7669. end;
  7670. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7671. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7672. var
  7673. Rec: TglBitmapNormalMapRec;
  7674. SizeRec: TglBitmapPixelPosition;
  7675. begin
  7676. Rec.HalfSize := aSize div 2;
  7677. FreeDataAfterGenTexture := false;
  7678. SizeRec.Fields := [ffX, ffY];
  7679. SizeRec.X := aSize;
  7680. SizeRec.Y := aSize;
  7681. // Positive X
  7682. Rec.Func := glBitmapNormalMapPosX;
  7683. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7684. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7685. // Negative X
  7686. Rec.Func := glBitmapNormalMapNegX;
  7687. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7688. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7689. // Positive Y
  7690. Rec.Func := glBitmapNormalMapPosY;
  7691. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7692. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7693. // Negative Y
  7694. Rec.Func := glBitmapNormalMapNegY;
  7695. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7696. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7697. // Positive Z
  7698. Rec.Func := glBitmapNormalMapPosZ;
  7699. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7700. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7701. // Negative Z
  7702. Rec.Func := glBitmapNormalMapNegZ;
  7703. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  7704. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7705. end;
  7706. initialization
  7707. glBitmapSetDefaultFormat (tfEmpty);
  7708. glBitmapSetDefaultMipmap (mmMipmap);
  7709. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7710. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7711. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7712. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7713. glBitmapSetDefaultDeleteTextureOnFree (true);
  7714. TFormatDescriptor.Init;
  7715. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7716. OpenGLInitialized := false;
  7717. InitOpenGLCS := TCriticalSection.Create;
  7718. {$ENDIF}
  7719. finalization
  7720. TFormatDescriptor.Finalize;
  7721. {$IFDEF GLB_NATIVE_OGL}
  7722. if Assigned(GL_LibHandle) then
  7723. glbFreeLibrary(GL_LibHandle);
  7724. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7725. if Assigned(GLU_LibHandle) then
  7726. glbFreeLibrary(GLU_LibHandle);
  7727. FreeAndNil(InitOpenGLCS);
  7728. {$ENDIF}
  7729. {$ENDIF}
  7730. end.