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.

9166 lines
324 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. TglBitmapColorRec = packed record
  758. case Integer of
  759. 0: (r, g, b, a: Cardinal);
  760. 1: (arr: array[0..3] of Cardinal);
  761. end;
  762. TglBitmapMask = packed record
  763. case Integer of
  764. 0: (r, g, b, a: QWord);
  765. 1: (arr: array[0..3] of QWord);
  766. end;
  767. TglBitmapPixelData = packed record
  768. Data, Range: TglBitmapColorRec;
  769. Format: TglBitmapFormat;
  770. end;
  771. PglBitmapPixelData = ^TglBitmapPixelData;
  772. ////////////////////////////////////////////////////////////////////////////////////////////////////
  773. TglBitmapPixelPositionFields = set of (ffX, ffY);
  774. TglBitmapPixelPosition = record
  775. Fields : TglBitmapPixelPositionFields;
  776. X : Word;
  777. Y : Word;
  778. end;
  779. TglBitmapFormatDescriptor = class(TObject)
  780. protected
  781. function GetIsCompressed: Boolean; virtual; abstract;
  782. function GetHasRed: Boolean; virtual; abstract;
  783. function GetHasGreen: Boolean; virtual; abstract;
  784. function GetHasBlue: Boolean; virtual; abstract;
  785. function GetHasAlpha: Boolean; virtual; abstract;
  786. function GetHasColor: Boolean; virtual; abstract;
  787. function GetIsGrayscale: Boolean; virtual; abstract;
  788. function GetRGBInverted: TglBitmapFormat; virtual; abstract;
  789. function GetWithAlpha: TglBitmapFormat; virtual; abstract;
  790. function GetWithoutAlpha: TglBitmapFormat; virtual; abstract;
  791. function GetOpenGLFormat: TglBitmapFormat; virtual; abstract;
  792. function GetUncompressed: TglBitmapFormat; virtual; abstract;
  793. function GetglDataFormat: GLenum; virtual; abstract;
  794. function GetglFormat: GLenum; virtual; abstract;
  795. function GetglInternalFormat: GLenum; virtual; abstract;
  796. public
  797. property IsCompressed: Boolean read GetIsCompressed;
  798. property HasRed: Boolean read GetHasRed;
  799. property HasGreen: Boolean read GetHasGreen;
  800. property HasBlue: Boolean read GetHasBlue;
  801. property HasAlpha: Boolean read GetHasAlpha;
  802. property HasColor: Boolean read GetHasColor;
  803. property IsGrayscale: Boolean read GetIsGrayscale;
  804. property RGBInverted: TglBitmapFormat read GetRGBInverted;
  805. property WithAlpha: TglBitmapFormat read GetWithAlpha;
  806. property WithoutAlpha: TglBitmapFormat read GetWithoutAlpha;
  807. property OpenGLFormat: TglBitmapFormat read GetOpenGLFormat;
  808. property Uncompressed: TglBitmapFormat read GetUncompressed;
  809. property glFormat: GLenum read GetglFormat;
  810. property glInternalFormat: GLenum read GetglInternalFormat;
  811. property glDataFormat: GLenum read GetglDataFormat;
  812. public
  813. class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  814. end;
  815. ////////////////////////////////////////////////////////////////////////////////////////////////////
  816. TglBitmap = class;
  817. TglBitmapFunctionRec = record
  818. Sender: TglBitmap;
  819. Size: TglBitmapPixelPosition;
  820. Position: TglBitmapPixelPosition;
  821. Source: TglBitmapPixelData;
  822. Dest: TglBitmapPixelData;
  823. Args: Pointer;
  824. end;
  825. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  826. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  827. TglBitmap = class
  828. private
  829. function GetFormatDesc: TglBitmapFormatDescriptor;
  830. protected
  831. fID: GLuint;
  832. fTarget: GLuint;
  833. fAnisotropic: Integer;
  834. fDeleteTextureOnFree: Boolean;
  835. fFreeDataOnDestroy: Boolean;
  836. fFreeDataAfterGenTexture: Boolean;
  837. fData: PByte;
  838. fIsResident: GLboolean;
  839. fBorderColor: array[0..3] of Single;
  840. fDimension: TglBitmapPixelPosition;
  841. fMipMap: TglBitmapMipMap;
  842. fFormat: TglBitmapFormat;
  843. // Mapping
  844. fPixelSize: Integer;
  845. fRowSize: Integer;
  846. // Filtering
  847. fFilterMin: GLenum;
  848. fFilterMag: GLenum;
  849. // TexturWarp
  850. fWrapS: GLenum;
  851. fWrapT: GLenum;
  852. fWrapR: GLenum;
  853. //Swizzle
  854. fSwizzle: array[0..3] of GLenum;
  855. // CustomData
  856. fFilename: String;
  857. fCustomName: String;
  858. fCustomNameW: WideString;
  859. fCustomData: Pointer;
  860. //Getter
  861. function GetWidth: Integer; virtual;
  862. function GetHeight: Integer; virtual;
  863. function GetFileWidth: Integer; virtual;
  864. function GetFileHeight: Integer; virtual;
  865. //Setter
  866. procedure SetCustomData(const aValue: Pointer);
  867. procedure SetCustomName(const aValue: String);
  868. procedure SetCustomNameW(const aValue: WideString);
  869. procedure SetFreeDataOnDestroy(const aValue: Boolean);
  870. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  871. procedure SetFormat(const aValue: TglBitmapFormat);
  872. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  873. procedure SetID(const aValue: Cardinal);
  874. procedure SetMipMap(const aValue: TglBitmapMipMap);
  875. procedure SetTarget(const aValue: Cardinal);
  876. procedure SetAnisotropic(const aValue: Integer);
  877. procedure CreateID;
  878. procedure SetupParameters(out aBuildWithGlu: Boolean);
  879. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  880. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method
  881. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  882. function FlipHorz: Boolean; virtual;
  883. function FlipVert: Boolean; virtual;
  884. property Width: Integer read GetWidth;
  885. property Height: Integer read GetHeight;
  886. property FileWidth: Integer read GetFileWidth;
  887. property FileHeight: Integer read GetFileHeight;
  888. public
  889. //Properties
  890. property ID: Cardinal read fID write SetID;
  891. property Target: Cardinal read fTarget write SetTarget;
  892. property Format: TglBitmapFormat read fFormat write SetFormat;
  893. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  894. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  895. property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc;
  896. property Filename: String read fFilename;
  897. property CustomName: String read fCustomName write SetCustomName;
  898. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  899. property CustomData: Pointer read fCustomData write SetCustomData;
  900. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  901. property FreeDataOnDestroy: Boolean read fFreeDataOnDestroy write SetFreeDataOnDestroy;
  902. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  903. property Dimension: TglBitmapPixelPosition read fDimension;
  904. property Data: PByte read fData;
  905. property IsResident: GLboolean read fIsResident;
  906. procedure AfterConstruction; override;
  907. procedure BeforeDestruction; override;
  908. procedure PrepareResType(var aResource: String; var aResType: PChar);
  909. //Load
  910. procedure LoadFromFile(const aFilename: String);
  911. procedure LoadFromStream(const aStream: TStream); virtual;
  912. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  913. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  914. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  915. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  916. //Save
  917. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  918. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  919. //Convert
  920. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  921. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  922. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  923. public
  924. //Alpha & Co
  925. {$IFDEF GLB_SDL}
  926. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  927. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  928. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  929. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  930. const aArgs: Pointer = nil): Boolean;
  931. {$ENDIF}
  932. {$IFDEF GLB_DELPHI}
  933. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  934. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  935. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  936. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  937. const aArgs: Pointer = nil): Boolean;
  938. {$ENDIF}
  939. {$IFDEF GLB_LAZARUS}
  940. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  941. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  942. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  943. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  944. const aArgs: Pointer = nil): Boolean;
  945. {$ENDIF}
  946. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  947. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  948. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  949. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  950. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  951. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  952. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  953. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  954. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  955. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  956. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  957. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  958. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  959. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  960. function RemoveAlpha: Boolean; virtual;
  961. public
  962. //Common
  963. function Clone: TglBitmap;
  964. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  965. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  966. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  967. procedure FreeData;
  968. //ColorFill
  969. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  970. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  971. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  972. //TexParameters
  973. procedure SetFilter(const aMin, aMag: GLenum);
  974. procedure SetWrap(
  975. const S: GLenum = GL_CLAMP_TO_EDGE;
  976. const T: GLenum = GL_CLAMP_TO_EDGE;
  977. const R: GLenum = GL_CLAMP_TO_EDGE);
  978. procedure SetSwizzle(const r, g, b, a: GLenum);
  979. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  980. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  981. //Constructors
  982. constructor Create; overload;
  983. constructor Create(const aFileName: String); overload;
  984. constructor Create(const aStream: TStream); overload;
  985. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  986. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  987. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  988. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  989. private
  990. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  991. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  992. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  993. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  994. function LoadBMP(const aStream: TStream): Boolean; virtual;
  995. procedure SaveBMP(const aStream: TStream); virtual;
  996. function LoadTGA(const aStream: TStream): Boolean; virtual;
  997. procedure SaveTGA(const aStream: TStream); virtual;
  998. function LoadDDS(const aStream: TStream): Boolean; virtual;
  999. procedure SaveDDS(const aStream: TStream); virtual;
  1000. end;
  1001. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1002. TglBitmap1D = class(TglBitmap)
  1003. protected
  1004. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  1005. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  1006. procedure UploadData(const aBuildWithGlu: Boolean);
  1007. public
  1008. property Width;
  1009. procedure AfterConstruction; override;
  1010. function FlipHorz: Boolean; override;
  1011. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  1012. end;
  1013. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1014. TglBitmap2D = class(TglBitmap)
  1015. protected
  1016. fLines: array of PByte;
  1017. function GetScanline(const aIndex: Integer): Pointer;
  1018. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  1019. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  1020. procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  1021. public
  1022. property Width;
  1023. property Height;
  1024. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  1025. procedure AfterConstruction; override;
  1026. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  1027. procedure GetDataFromTexture;
  1028. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  1029. function FlipHorz: Boolean; override;
  1030. function FlipVert: Boolean; override;
  1031. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  1032. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  1033. end;
  1034. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1035. TglBitmapCubeMap = class(TglBitmap2D)
  1036. protected
  1037. fGenMode: Integer;
  1038. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  1039. public
  1040. procedure AfterConstruction; override;
  1041. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  1042. procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  1043. procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  1044. end;
  1045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1046. TglBitmapNormalMap = class(TglBitmapCubeMap)
  1047. public
  1048. procedure AfterConstruction; override;
  1049. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  1050. end;
  1051. const
  1052. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1053. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1054. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1055. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1056. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1057. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1058. procedure glBitmapSetDefaultWrap(
  1059. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1060. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1061. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1062. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1063. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1064. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1065. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1066. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1067. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1068. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1069. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1070. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1071. function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
  1072. var
  1073. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1074. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1075. glBitmapDefaultFormat: TglBitmapFormat;
  1076. glBitmapDefaultMipmap: TglBitmapMipMap;
  1077. glBitmapDefaultFilterMin: Cardinal;
  1078. glBitmapDefaultFilterMag: Cardinal;
  1079. glBitmapDefaultWrapS: Cardinal;
  1080. glBitmapDefaultWrapT: Cardinal;
  1081. glBitmapDefaultWrapR: Cardinal;
  1082. glDefaultSwizzle: array[0..3] of GLenum;
  1083. {$IFDEF GLB_DELPHI}
  1084. function CreateGrayPalette: HPALETTE;
  1085. {$ENDIF}
  1086. implementation
  1087. uses
  1088. Math, syncobjs, typinfo
  1089. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1090. type
  1091. {$IFNDEF fpc}
  1092. QWord = System.UInt64;
  1093. PQWord = ^QWord;
  1094. PtrInt = Longint;
  1095. PtrUInt = DWord;
  1096. {$ENDIF}
  1097. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1098. TShiftRec = packed record
  1099. case Integer of
  1100. 0: (r, g, b, a: Byte);
  1101. 1: (arr: array[0..3] of Byte);
  1102. end;
  1103. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1104. private
  1105. function GetRedMask: QWord;
  1106. function GetGreenMask: QWord;
  1107. function GetBlueMask: QWord;
  1108. function GetAlphaMask: QWord;
  1109. protected
  1110. fFormat: TglBitmapFormat;
  1111. fWithAlpha: TglBitmapFormat;
  1112. fWithoutAlpha: TglBitmapFormat;
  1113. fOpenGLFormat: TglBitmapFormat;
  1114. fRGBInverted: TglBitmapFormat;
  1115. fUncompressed: TglBitmapFormat;
  1116. fPixelSize: Single;
  1117. fIsCompressed: Boolean;
  1118. fRange: TglBitmapColorRec;
  1119. fShift: TShiftRec;
  1120. fglFormat: GLenum;
  1121. fglInternalFormat: GLenum;
  1122. fglDataFormat: GLenum;
  1123. function GetIsCompressed: Boolean; override;
  1124. function GetHasRed: Boolean; override;
  1125. function GetHasGreen: Boolean; override;
  1126. function GetHasBlue: Boolean; override;
  1127. function GetHasAlpha: Boolean; override;
  1128. function GetHasColor: Boolean; override;
  1129. function GetIsGrayscale: Boolean; override;
  1130. function GetRGBInverted: TglBitmapFormat; override;
  1131. function GetWithAlpha: TglBitmapFormat; override;
  1132. function GetWithoutAlpha: TglBitmapFormat; override;
  1133. function GetOpenGLFormat: TglBitmapFormat; override;
  1134. function GetUncompressed: TglBitmapFormat; override;
  1135. function GetglFormat: GLenum; override;
  1136. function GetglInternalFormat: GLenum; override;
  1137. function GetglDataFormat: GLenum; override;
  1138. function GetComponents: Integer; virtual;
  1139. public
  1140. property Format: TglBitmapFormat read fFormat;
  1141. property Components: Integer read GetComponents;
  1142. property PixelSize: Single read fPixelSize;
  1143. property Range: TglBitmapColorRec read fRange;
  1144. property Shift: TShiftRec read fShift;
  1145. property RedMask: QWord read GetRedMask;
  1146. property GreenMask: QWord read GetGreenMask;
  1147. property BlueMask: QWord read GetBlueMask;
  1148. property AlphaMask: QWord read GetAlphaMask;
  1149. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1150. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1151. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1152. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1153. function CreateMappingData: Pointer; virtual;
  1154. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1155. function IsEmpty: Boolean; virtual;
  1156. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual; overload;
  1157. function MaskMatch(const aMask: TglBitmapMask): Boolean; virtual; overload;
  1158. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1159. constructor Create; virtual;
  1160. public
  1161. class procedure Init;
  1162. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1163. class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1164. class function GetFromMask(const aMask: TglBitmapMask; const aBitCount: Integer = 0): TFormatDescriptor;
  1165. class procedure Clear;
  1166. class procedure Finalize;
  1167. end;
  1168. TFormatDescriptorClass = class of TFormatDescriptor;
  1169. TfdEmpty = class(TFormatDescriptor);
  1170. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1171. TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
  1172. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1173. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1174. end;
  1175. TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
  1176. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1177. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1178. end;
  1179. TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
  1180. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1181. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1182. end;
  1183. TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
  1184. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1185. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1186. end;
  1187. TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
  1188. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1189. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1190. end;
  1191. TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1192. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1193. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1194. end;
  1195. TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
  1196. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1197. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1198. end;
  1199. TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
  1200. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1201. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1202. end;
  1203. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1204. TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
  1205. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1206. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1207. end;
  1208. TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
  1209. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1210. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1211. end;
  1212. TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
  1213. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1214. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1215. end;
  1216. TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
  1217. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1218. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1219. end;
  1220. TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
  1221. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1222. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1223. end;
  1224. TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
  1225. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1226. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1227. end;
  1228. TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1229. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1230. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1231. end;
  1232. TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
  1233. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1234. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1235. end;
  1236. TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
  1237. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1238. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1239. end;
  1240. TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1241. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1242. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1243. end;
  1244. TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1245. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1246. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1247. end;
  1248. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1249. TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
  1250. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1251. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1252. end;
  1253. TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
  1254. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1255. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1256. end;
  1257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1258. TfdAlpha4ub1 = class(TfdAlphaUB1)
  1259. constructor Create; override;
  1260. end;
  1261. TfdAlpha8ub1 = class(TfdAlphaUB1)
  1262. constructor Create; override;
  1263. end;
  1264. TfdAlpha16us1 = class(TfdAlphaUS1)
  1265. constructor Create; override;
  1266. end;
  1267. TfdLuminance4ub1 = class(TfdLuminanceUB1)
  1268. constructor Create; override;
  1269. end;
  1270. TfdLuminance8ub1 = class(TfdLuminanceUB1)
  1271. constructor Create; override;
  1272. end;
  1273. TfdLuminance16us1 = class(TfdLuminanceUS1)
  1274. constructor Create; override;
  1275. end;
  1276. TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
  1277. constructor Create; override;
  1278. end;
  1279. TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
  1280. constructor Create; override;
  1281. end;
  1282. TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
  1283. constructor Create; override;
  1284. end;
  1285. TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
  1286. constructor Create; override;
  1287. end;
  1288. TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
  1289. constructor Create; override;
  1290. end;
  1291. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1292. TfdR3G3B2ub1 = class(TfdUniversalUB1)
  1293. constructor Create; override;
  1294. end;
  1295. TfdRGBX4us1 = class(TfdUniversalUS1)
  1296. constructor Create; override;
  1297. end;
  1298. TfdXRGB4us1 = class(TfdUniversalUS1)
  1299. constructor Create; override;
  1300. end;
  1301. TfdR5G6B5us1 = class(TfdUniversalUS1)
  1302. constructor Create; override;
  1303. end;
  1304. TfdRGB5X1us1 = class(TfdUniversalUS1)
  1305. constructor Create; override;
  1306. end;
  1307. TfdX1RGB5us1 = class(TfdUniversalUS1)
  1308. constructor Create; override;
  1309. end;
  1310. TfdRGB8ub3 = class(TfdRGBub3)
  1311. constructor Create; override;
  1312. end;
  1313. TfdRGBX8ui1 = class(TfdUniversalUI1)
  1314. constructor Create; override;
  1315. end;
  1316. TfdXRGB8ui1 = class(TfdUniversalUI1)
  1317. constructor Create; override;
  1318. end;
  1319. TfdRGB10X2ui1 = class(TfdUniversalUI1)
  1320. constructor Create; override;
  1321. end;
  1322. TfdX2RGB10ui1 = class(TfdUniversalUI1)
  1323. constructor Create; override;
  1324. end;
  1325. TfdRGB16us3 = class(TfdRGBus3)
  1326. constructor Create; override;
  1327. end;
  1328. TfdRGBA4us1 = class(TfdUniversalUS1)
  1329. constructor Create; override;
  1330. end;
  1331. TfdARGB4us1 = class(TfdUniversalUS1)
  1332. constructor Create; override;
  1333. end;
  1334. TfdRGB5A1us1 = class(TfdUniversalUS1)
  1335. constructor Create; override;
  1336. end;
  1337. TfdA1RGB5us1 = class(TfdUniversalUS1)
  1338. constructor Create; override;
  1339. end;
  1340. TfdRGBA8ui1 = class(TfdUniversalUI1)
  1341. constructor Create; override;
  1342. end;
  1343. TfdARGB8ui1 = class(TfdUniversalUI1)
  1344. constructor Create; override;
  1345. end;
  1346. TfdRGBA8ub4 = class(TfdRGBAub4)
  1347. constructor Create; override;
  1348. end;
  1349. TfdRGB10A2ui1 = class(TfdUniversalUI1)
  1350. constructor Create; override;
  1351. end;
  1352. TfdA2RGB10ui1 = class(TfdUniversalUI1)
  1353. constructor Create; override;
  1354. end;
  1355. TfdRGBA16us4 = class(TfdRGBAus4)
  1356. constructor Create; override;
  1357. end;
  1358. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1359. TfdBGRX4us1 = class(TfdUniversalUS1)
  1360. constructor Create; override;
  1361. end;
  1362. TfdXBGR4us1 = class(TfdUniversalUS1)
  1363. constructor Create; override;
  1364. end;
  1365. TfdB5G6R5us1 = class(TfdUniversalUS1)
  1366. constructor Create; override;
  1367. end;
  1368. TfdBGR5X1us1 = class(TfdUniversalUS1)
  1369. constructor Create; override;
  1370. end;
  1371. TfdX1BGR5us1 = class(TfdUniversalUS1)
  1372. constructor Create; override;
  1373. end;
  1374. TfdBGR8ub3 = class(TfdBGRub3)
  1375. constructor Create; override;
  1376. end;
  1377. TfdBGRX8ui1 = class(TfdUniversalUI1)
  1378. constructor Create; override;
  1379. end;
  1380. TfdXBGR8ui1 = class(TfdUniversalUI1)
  1381. constructor Create; override;
  1382. end;
  1383. TfdBGR10X2ui1 = class(TfdUniversalUI1)
  1384. constructor Create; override;
  1385. end;
  1386. TfdX2BGR10ui1 = class(TfdUniversalUI1)
  1387. constructor Create; override;
  1388. end;
  1389. TfdBGR16us3 = class(TfdBGRus3)
  1390. constructor Create; override;
  1391. end;
  1392. TfdBGRA4us1 = class(TfdUniversalUS1)
  1393. constructor Create; override;
  1394. end;
  1395. TfdABGR4us1 = class(TfdUniversalUS1)
  1396. constructor Create; override;
  1397. end;
  1398. TfdBGR5A1us1 = class(TfdUniversalUS1)
  1399. constructor Create; override;
  1400. end;
  1401. TfdA1BGR5us1 = class(TfdUniversalUS1)
  1402. constructor Create; override;
  1403. end;
  1404. TfdBGRA8ui1 = class(TfdUniversalUI1)
  1405. constructor Create; override;
  1406. end;
  1407. TfdABGR8ui1 = class(TfdUniversalUI1)
  1408. constructor Create; override;
  1409. end;
  1410. TfdBGRA8ub4 = class(TfdBGRAub4)
  1411. constructor Create; override;
  1412. end;
  1413. TfdBGR10A2ui1 = class(TfdUniversalUI1)
  1414. constructor Create; override;
  1415. end;
  1416. TfdA2BGR10ui1 = class(TfdUniversalUI1)
  1417. constructor Create; override;
  1418. end;
  1419. TfdBGRA16us4 = class(TfdBGRAus4)
  1420. constructor Create; override;
  1421. end;
  1422. TfdDepth16us1 = class(TfdDepthUS1)
  1423. constructor Create; override;
  1424. end;
  1425. TfdDepth24ui1 = class(TfdDepthUI1)
  1426. constructor Create; override;
  1427. end;
  1428. TfdDepth32ui1 = class(TfdDepthUI1)
  1429. constructor Create; override;
  1430. end;
  1431. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1432. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1433. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1434. constructor Create; override;
  1435. end;
  1436. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1437. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1438. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1439. constructor Create; override;
  1440. end;
  1441. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1442. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1443. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1444. constructor Create; override;
  1445. end;
  1446. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1447. TbmpBitfieldFormat = class(TFormatDescriptor)
  1448. private
  1449. procedure SetRedMask (const aValue: QWord);
  1450. procedure SetGreenMask(const aValue: QWord);
  1451. procedure SetBlueMask (const aValue: QWord);
  1452. procedure SetAlphaMask(const aValue: QWord);
  1453. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1454. public
  1455. property RedMask: QWord read GetRedMask write SetRedMask;
  1456. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1457. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1458. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1459. property PixelSize: Single read fPixelSize write fPixelSize;
  1460. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1461. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1462. end;
  1463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1464. TbmpColorTableEnty = packed record
  1465. b, g, r, a: Byte;
  1466. end;
  1467. TbmpColorTable = array of TbmpColorTableEnty;
  1468. TbmpColorTableFormat = class(TFormatDescriptor)
  1469. private
  1470. fColorTable: TbmpColorTable;
  1471. public
  1472. property PixelSize: Single read fPixelSize write fPixelSize;
  1473. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1474. property Range: TglBitmapColorRec read fRange write fRange;
  1475. property Shift: TShiftRec read fShift write fShift;
  1476. property Format: TglBitmapFormat read fFormat write fFormat;
  1477. procedure CreateColorTable;
  1478. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1479. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1480. destructor Destroy; override;
  1481. end;
  1482. const
  1483. LUMINANCE_WEIGHT_R = 0.30;
  1484. LUMINANCE_WEIGHT_G = 0.59;
  1485. LUMINANCE_WEIGHT_B = 0.11;
  1486. ALPHA_WEIGHT_R = 0.30;
  1487. ALPHA_WEIGHT_G = 0.59;
  1488. ALPHA_WEIGHT_B = 0.11;
  1489. DEPTH_WEIGHT_R = 0.333333333;
  1490. DEPTH_WEIGHT_G = 0.333333333;
  1491. DEPTH_WEIGHT_B = 0.333333333;
  1492. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1493. TfdEmpty,
  1494. TfdAlpha4ub1,
  1495. TfdAlpha8ub1,
  1496. TfdAlpha16us1,
  1497. TfdLuminance4ub1,
  1498. TfdLuminance8ub1,
  1499. TfdLuminance16us1,
  1500. TfdLuminance4Alpha4ub2,
  1501. TfdLuminance6Alpha2ub2,
  1502. TfdLuminance8Alpha8ub2,
  1503. TfdLuminance12Alpha4us2,
  1504. TfdLuminance16Alpha16us2,
  1505. TfdR3G3B2ub1,
  1506. TfdRGBX4us1,
  1507. TfdXRGB4us1,
  1508. TfdR5G6B5us1,
  1509. TfdRGB5X1us1,
  1510. TfdX1RGB5us1,
  1511. TfdRGB8ub3,
  1512. TfdRGBX8ui1,
  1513. TfdXRGB8ui1,
  1514. TfdRGB10X2ui1,
  1515. TfdX2RGB10ui1,
  1516. TfdRGB16us3,
  1517. TfdRGBA4us1,
  1518. TfdARGB4us1,
  1519. TfdRGB5A1us1,
  1520. TfdA1RGB5us1,
  1521. TfdRGBA8ui1,
  1522. TfdARGB8ui1,
  1523. TfdRGBA8ub4,
  1524. TfdRGB10A2ui1,
  1525. TfdA2RGB10ui1,
  1526. TfdRGBA16us4,
  1527. TfdBGRX4us1,
  1528. TfdXBGR4us1,
  1529. TfdB5G6R5us1,
  1530. TfdBGR5X1us1,
  1531. TfdX1BGR5us1,
  1532. TfdBGR8ub3,
  1533. TfdBGRX8ui1,
  1534. TfdXBGR8ui1,
  1535. TfdBGR10X2ui1,
  1536. TfdX2BGR10ui1,
  1537. TfdBGR16us3,
  1538. TfdBGRA4us1,
  1539. TfdABGR4us1,
  1540. TfdBGR5A1us1,
  1541. TfdA1BGR5us1,
  1542. TfdBGRA8ui1,
  1543. TfdABGR8ui1,
  1544. TfdBGRA8ub4,
  1545. TfdBGR10A2ui1,
  1546. TfdA2BGR10ui1,
  1547. TfdBGRA16us4,
  1548. TfdDepth16us1,
  1549. TfdDepth24ui1,
  1550. TfdDepth32ui1,
  1551. TfdS3tcDtx1RGBA,
  1552. TfdS3tcDtx3RGBA,
  1553. TfdS3tcDtx5RGBA
  1554. );
  1555. var
  1556. FormatDescriptorCS: TCriticalSection;
  1557. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1558. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1559. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1560. begin
  1561. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1562. end;
  1563. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1564. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1565. begin
  1566. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1567. end;
  1568. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1569. function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
  1570. begin
  1571. result.Fields := [];
  1572. if X >= 0 then
  1573. result.Fields := result.Fields + [ffX];
  1574. if Y >= 0 then
  1575. result.Fields := result.Fields + [ffY];
  1576. result.X := Max(0, X);
  1577. result.Y := Max(0, Y);
  1578. end;
  1579. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1580. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1581. begin
  1582. result.r := r;
  1583. result.g := g;
  1584. result.b := b;
  1585. result.a := a;
  1586. end;
  1587. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1588. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1589. var
  1590. i: Integer;
  1591. begin
  1592. result := false;
  1593. for i := 0 to high(r1.arr) do
  1594. if (r1.arr[i] <> r2.arr[i]) then
  1595. exit;
  1596. result := true;
  1597. end;
  1598. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1599. function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;
  1600. var
  1601. desc: TFormatDescriptor;
  1602. p, tmp: PByte;
  1603. x, y, i: Integer;
  1604. md: Pointer;
  1605. px: TglBitmapPixelData;
  1606. begin
  1607. result := nil;
  1608. desc := TFormatDescriptor.Get(aFormat);
  1609. if (desc.IsCompressed) or (desc.glFormat = 0) then
  1610. exit;
  1611. p := GetMem(ceil(25 * desc.PixelSize)); // 5 x 5 pixel
  1612. md := desc.CreateMappingData;
  1613. try
  1614. tmp := p;
  1615. desc.PreparePixel(px);
  1616. for y := 0 to 4 do
  1617. for x := 0 to 4 do begin
  1618. px.Data := glBitmapColorRec(0, 0, 0, 0);
  1619. for i := 0 to 3 do begin
  1620. if ((y < 3) and (y = i)) or
  1621. ((y = 3) and (i < 3)) or
  1622. ((y = 4) and (i = 3))
  1623. then
  1624. px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
  1625. else if ((y < 4) and (i = 3)) or
  1626. ((y = 4) and (i < 3))
  1627. then
  1628. px.Data.arr[i] := px.Range.arr[i]
  1629. else
  1630. px.Data.arr[i] := 0; //px.Range.arr[i];
  1631. end;
  1632. desc.Map(px, tmp, md);
  1633. end;
  1634. finally
  1635. desc.FreeMappingData(md);
  1636. end;
  1637. result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);
  1638. result.FreeDataOnDestroy := true;
  1639. result.FreeDataAfterGenTexture := false;
  1640. result.SetFilter(GL_NEAREST, GL_NEAREST);
  1641. end;
  1642. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1643. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1644. begin
  1645. result.r := r;
  1646. result.g := g;
  1647. result.b := b;
  1648. result.a := a;
  1649. end;
  1650. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1651. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1652. begin
  1653. result := [];
  1654. if (aFormat in [
  1655. //8bpp
  1656. tfAlpha4ub1, tfAlpha8ub1,
  1657. tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
  1658. //16bpp
  1659. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1660. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  1661. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
  1662. //24bpp
  1663. tfBGR8ub3, tfRGB8ub3,
  1664. //32bpp
  1665. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  1666. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
  1667. then
  1668. result := result + [ ftBMP ];
  1669. if (aFormat in [
  1670. //8bbp
  1671. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
  1672. //16bbp
  1673. tfAlpha16us1, tfLuminance16us1,
  1674. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1675. tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
  1676. //24bbp
  1677. tfBGR8ub3,
  1678. //32bbp
  1679. tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
  1680. tfDepth24ui1, tfDepth32ui1])
  1681. then
  1682. result := result + [ftTGA];
  1683. if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
  1684. result := result + [ftDDS];
  1685. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1686. if aFormat in [
  1687. tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
  1688. tfRGB8ub3, tfRGBA8ui1,
  1689. tfBGR8ub3, tfBGRA8ui1] then
  1690. result := result + [ftPNG];
  1691. {$ENDIF}
  1692. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1693. if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
  1694. result := result + [ftJPEG];
  1695. {$ENDIF}
  1696. end;
  1697. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1698. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1699. begin
  1700. while (aNumber and 1) = 0 do
  1701. aNumber := aNumber shr 1;
  1702. result := aNumber = 1;
  1703. end;
  1704. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1705. function GetTopMostBit(aBitSet: QWord): Integer;
  1706. begin
  1707. result := 0;
  1708. while aBitSet > 0 do begin
  1709. inc(result);
  1710. aBitSet := aBitSet shr 1;
  1711. end;
  1712. end;
  1713. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1714. function CountSetBits(aBitSet: QWord): Integer;
  1715. begin
  1716. result := 0;
  1717. while aBitSet > 0 do begin
  1718. if (aBitSet and 1) = 1 then
  1719. inc(result);
  1720. aBitSet := aBitSet shr 1;
  1721. end;
  1722. end;
  1723. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1724. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1725. begin
  1726. result := Trunc(
  1727. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1728. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1729. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1730. end;
  1731. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1732. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1733. begin
  1734. result := Trunc(
  1735. DEPTH_WEIGHT_R * aPixel.Data.r +
  1736. DEPTH_WEIGHT_G * aPixel.Data.g +
  1737. DEPTH_WEIGHT_B * aPixel.Data.b);
  1738. end;
  1739. {$IFDEF GLB_NATIVE_OGL}
  1740. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1741. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1742. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1743. var
  1744. GL_LibHandle: Pointer = nil;
  1745. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
  1746. begin
  1747. if not Assigned(aLibHandle) then
  1748. aLibHandle := GL_LibHandle;
  1749. {$IF DEFINED(GLB_WIN)}
  1750. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1751. if Assigned(result) then
  1752. exit;
  1753. if Assigned(wglGetProcAddress) then
  1754. result := wglGetProcAddress(aProcName);
  1755. {$ELSEIF DEFINED(GLB_LINUX)}
  1756. if Assigned(glXGetProcAddress) then begin
  1757. result := glXGetProcAddress(aProcName);
  1758. if Assigned(result) then
  1759. exit;
  1760. end;
  1761. if Assigned(glXGetProcAddressARB) then begin
  1762. result := glXGetProcAddressARB(aProcName);
  1763. if Assigned(result) then
  1764. exit;
  1765. end;
  1766. result := dlsym(aLibHandle, aProcName);
  1767. {$IFEND}
  1768. if not Assigned(result) and aRaiseOnErr then
  1769. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1770. end;
  1771. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1772. var
  1773. GLU_LibHandle: Pointer = nil;
  1774. OpenGLInitialized: Boolean;
  1775. InitOpenGLCS: TCriticalSection;
  1776. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1777. procedure glbInitOpenGL;
  1778. ////////////////////////////////////////////////////////////////////////////////
  1779. function glbLoadLibrary(const aName: PChar): Pointer;
  1780. begin
  1781. {$IF DEFINED(GLB_WIN)}
  1782. result := {%H-}Pointer(LoadLibrary(aName));
  1783. {$ELSEIF DEFINED(GLB_LINUX)}
  1784. result := dlopen(Name, RTLD_LAZY);
  1785. {$ELSE}
  1786. result := nil;
  1787. {$IFEND}
  1788. end;
  1789. ////////////////////////////////////////////////////////////////////////////////
  1790. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1791. begin
  1792. result := false;
  1793. if not Assigned(aLibHandle) then
  1794. exit;
  1795. {$IF DEFINED(GLB_WIN)}
  1796. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1797. {$ELSEIF DEFINED(GLB_LINUX)}
  1798. Result := dlclose(aLibHandle) = 0;
  1799. {$IFEND}
  1800. end;
  1801. begin
  1802. if Assigned(GL_LibHandle) then
  1803. glbFreeLibrary(GL_LibHandle);
  1804. if Assigned(GLU_LibHandle) then
  1805. glbFreeLibrary(GLU_LibHandle);
  1806. GL_LibHandle := glbLoadLibrary(libopengl);
  1807. if not Assigned(GL_LibHandle) then
  1808. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1809. GLU_LibHandle := glbLoadLibrary(libglu);
  1810. if not Assigned(GLU_LibHandle) then
  1811. raise EglBitmap.Create('unable to load library: ' + libglu);
  1812. {$IF DEFINED(GLB_WIN)}
  1813. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1814. {$ELSEIF DEFINED(GLB_LINUX)}
  1815. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1816. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1817. {$IFEND}
  1818. glEnable := glbGetProcAddress('glEnable');
  1819. glDisable := glbGetProcAddress('glDisable');
  1820. glGetString := glbGetProcAddress('glGetString');
  1821. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1822. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1823. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1824. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1825. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1826. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1827. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1828. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1829. glTexGeni := glbGetProcAddress('glTexGeni');
  1830. glGenTextures := glbGetProcAddress('glGenTextures');
  1831. glBindTexture := glbGetProcAddress('glBindTexture');
  1832. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1833. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1834. glReadPixels := glbGetProcAddress('glReadPixels');
  1835. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1836. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1837. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1838. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1839. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1840. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1841. end;
  1842. {$ENDIF}
  1843. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1844. procedure glbReadOpenGLExtensions;
  1845. var
  1846. Buffer: AnsiString;
  1847. MajorVersion, MinorVersion: Integer;
  1848. ///////////////////////////////////////////////////////////////////////////////////////////
  1849. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1850. var
  1851. Separator: Integer;
  1852. begin
  1853. aMinor := 0;
  1854. aMajor := 0;
  1855. Separator := Pos(AnsiString('.'), aBuffer);
  1856. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1857. (aBuffer[Separator - 1] in ['0'..'9']) and
  1858. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1859. Dec(Separator);
  1860. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1861. Dec(Separator);
  1862. Delete(aBuffer, 1, Separator);
  1863. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1864. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1865. Inc(Separator);
  1866. Delete(aBuffer, Separator, 255);
  1867. Separator := Pos(AnsiString('.'), aBuffer);
  1868. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1869. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1870. end;
  1871. end;
  1872. ///////////////////////////////////////////////////////////////////////////////////////////
  1873. function CheckExtension(const Extension: AnsiString): Boolean;
  1874. var
  1875. ExtPos: Integer;
  1876. begin
  1877. ExtPos := Pos(Extension, Buffer);
  1878. result := ExtPos > 0;
  1879. if result then
  1880. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1881. end;
  1882. ///////////////////////////////////////////////////////////////////////////////////////////
  1883. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1884. begin
  1885. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1886. end;
  1887. begin
  1888. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1889. InitOpenGLCS.Enter;
  1890. try
  1891. if not OpenGLInitialized then begin
  1892. glbInitOpenGL;
  1893. OpenGLInitialized := true;
  1894. end;
  1895. finally
  1896. InitOpenGLCS.Leave;
  1897. end;
  1898. {$ENDIF}
  1899. // Version
  1900. Buffer := glGetString(GL_VERSION);
  1901. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1902. GL_VERSION_1_2 := CheckVersion(1, 2);
  1903. GL_VERSION_1_3 := CheckVersion(1, 3);
  1904. GL_VERSION_1_4 := CheckVersion(1, 4);
  1905. GL_VERSION_2_0 := CheckVersion(2, 0);
  1906. GL_VERSION_3_3 := CheckVersion(3, 3);
  1907. // Extensions
  1908. Buffer := glGetString(GL_EXTENSIONS);
  1909. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1910. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1911. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1912. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1913. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1914. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1915. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1916. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1917. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1918. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1919. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1920. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1921. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1922. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1923. if GL_VERSION_1_3 then begin
  1924. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1925. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1926. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1927. end else begin
  1928. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false);
  1929. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false);
  1930. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
  1931. end;
  1932. end;
  1933. {$ENDIF}
  1934. {$IFDEF GLB_SDL_IMAGE}
  1935. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1936. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1937. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1938. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1939. begin
  1940. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1941. end;
  1942. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1943. begin
  1944. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1945. end;
  1946. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1947. begin
  1948. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1949. end;
  1950. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1951. begin
  1952. result := 0;
  1953. end;
  1954. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1955. begin
  1956. result := SDL_AllocRW;
  1957. if result = nil then
  1958. raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1959. result^.seek := glBitmapRWseek;
  1960. result^.read := glBitmapRWread;
  1961. result^.write := glBitmapRWwrite;
  1962. result^.close := glBitmapRWclose;
  1963. result^.unknown.data1 := Stream;
  1964. end;
  1965. {$ENDIF}
  1966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1967. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1968. begin
  1969. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1970. end;
  1971. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1972. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1973. begin
  1974. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1975. end;
  1976. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1977. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1978. begin
  1979. glBitmapDefaultMipmap := aValue;
  1980. end;
  1981. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1982. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1983. begin
  1984. glBitmapDefaultFormat := aFormat;
  1985. end;
  1986. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1987. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1988. begin
  1989. glBitmapDefaultFilterMin := aMin;
  1990. glBitmapDefaultFilterMag := aMag;
  1991. end;
  1992. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1993. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1994. begin
  1995. glBitmapDefaultWrapS := S;
  1996. glBitmapDefaultWrapT := T;
  1997. glBitmapDefaultWrapR := R;
  1998. end;
  1999. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2000. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  2001. begin
  2002. glDefaultSwizzle[0] := r;
  2003. glDefaultSwizzle[1] := g;
  2004. glDefaultSwizzle[2] := b;
  2005. glDefaultSwizzle[3] := a;
  2006. end;
  2007. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2008. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  2009. begin
  2010. result := glBitmapDefaultDeleteTextureOnFree;
  2011. end;
  2012. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2013. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  2014. begin
  2015. result := glBitmapDefaultFreeDataAfterGenTextures;
  2016. end;
  2017. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2018. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  2019. begin
  2020. result := glBitmapDefaultMipmap;
  2021. end;
  2022. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2023. function glBitmapGetDefaultFormat: TglBitmapFormat;
  2024. begin
  2025. result := glBitmapDefaultFormat;
  2026. end;
  2027. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2028. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  2029. begin
  2030. aMin := glBitmapDefaultFilterMin;
  2031. aMag := glBitmapDefaultFilterMag;
  2032. end;
  2033. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2034. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  2035. begin
  2036. S := glBitmapDefaultWrapS;
  2037. T := glBitmapDefaultWrapT;
  2038. R := glBitmapDefaultWrapR;
  2039. end;
  2040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2041. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  2042. begin
  2043. r := glDefaultSwizzle[0];
  2044. g := glDefaultSwizzle[1];
  2045. b := glDefaultSwizzle[2];
  2046. a := glDefaultSwizzle[3];
  2047. end;
  2048. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2049. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2051. function TFormatDescriptor.GetRedMask: QWord;
  2052. begin
  2053. result := fRange.r shl fShift.r;
  2054. end;
  2055. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2056. function TFormatDescriptor.GetGreenMask: QWord;
  2057. begin
  2058. result := fRange.g shl fShift.g;
  2059. end;
  2060. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2061. function TFormatDescriptor.GetBlueMask: QWord;
  2062. begin
  2063. result := fRange.b shl fShift.b;
  2064. end;
  2065. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2066. function TFormatDescriptor.GetAlphaMask: QWord;
  2067. begin
  2068. result := fRange.a shl fShift.a;
  2069. end;
  2070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2071. function TFormatDescriptor.GetIsCompressed: Boolean;
  2072. begin
  2073. result := fIsCompressed;
  2074. end;
  2075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2076. function TFormatDescriptor.GetHasRed: Boolean;
  2077. begin
  2078. result := (fRange.r > 0);
  2079. end;
  2080. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2081. function TFormatDescriptor.GetHasGreen: Boolean;
  2082. begin
  2083. result := (fRange.g > 0);
  2084. end;
  2085. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2086. function TFormatDescriptor.GetHasBlue: Boolean;
  2087. begin
  2088. result := (fRange.b > 0);
  2089. end;
  2090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2091. function TFormatDescriptor.GetHasAlpha: Boolean;
  2092. begin
  2093. result := (fRange.a > 0);
  2094. end;
  2095. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2096. function TFormatDescriptor.GetHasColor: Boolean;
  2097. begin
  2098. result := HasRed or HasGreen or HasAlpha;
  2099. end;
  2100. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2101. function TFormatDescriptor.GetIsGrayscale: Boolean;
  2102. var
  2103. r, g, b: QWord;
  2104. begin
  2105. r := RedMask;
  2106. g := GreenMask;
  2107. b := BlueMask;
  2108. result := (r = g) and (g = b) and (r > 0);
  2109. end;
  2110. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2111. function TFormatDescriptor.GetRGBInverted: TglBitmapFormat;
  2112. begin
  2113. result := fRGBInverted;
  2114. end;
  2115. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2116. function TFormatDescriptor.GetWithAlpha: TglBitmapFormat;
  2117. begin
  2118. result := fWithAlpha;
  2119. end;
  2120. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2121. function TFormatDescriptor.GetWithoutAlpha: TglBitmapFormat;
  2122. begin
  2123. result := fWithoutAlpha;
  2124. end;
  2125. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2126. function TFormatDescriptor.GetOpenGLFormat: TglBitmapFormat;
  2127. begin
  2128. result := fOpenGLFormat;
  2129. end;
  2130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2131. function TFormatDescriptor.GetUncompressed: TglBitmapFormat;
  2132. begin
  2133. result := fUncompressed;
  2134. end;
  2135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2136. function TFormatDescriptor.GetglFormat: GLenum;
  2137. begin
  2138. result := fglFormat;
  2139. end;
  2140. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2141. function TFormatDescriptor.GetglInternalFormat: GLenum;
  2142. begin
  2143. result := fglInternalFormat;
  2144. end;
  2145. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2146. function TFormatDescriptor.GetglDataFormat: GLenum;
  2147. begin
  2148. result := fglDataFormat;
  2149. end;
  2150. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2151. function TFormatDescriptor.GetComponents: Integer;
  2152. var
  2153. i: Integer;
  2154. begin
  2155. result := 0;
  2156. for i := 0 to 3 do
  2157. if (fRange.arr[i] > 0) then
  2158. inc(result);
  2159. end;
  2160. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2161. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  2162. var
  2163. w, h: Integer;
  2164. begin
  2165. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  2166. w := Max(1, aSize.X);
  2167. h := Max(1, aSize.Y);
  2168. result := GetSize(w, h);
  2169. end else
  2170. result := 0;
  2171. end;
  2172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2173. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  2174. begin
  2175. result := 0;
  2176. if (aWidth <= 0) or (aHeight <= 0) then
  2177. exit;
  2178. result := Ceil(aWidth * aHeight * fPixelSize);
  2179. end;
  2180. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2181. function TFormatDescriptor.CreateMappingData: Pointer;
  2182. begin
  2183. result := nil;
  2184. end;
  2185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2186. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2187. begin
  2188. //DUMMY
  2189. end;
  2190. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2191. function TFormatDescriptor.IsEmpty: Boolean;
  2192. begin
  2193. result := (fFormat = tfEmpty);
  2194. end;
  2195. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2196. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  2197. begin
  2198. result := false;
  2199. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2200. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2201. if (aRedMask <> RedMask) then
  2202. exit;
  2203. if (aGreenMask <> GreenMask) then
  2204. exit;
  2205. if (aBlueMask <> BlueMask) then
  2206. exit;
  2207. if (aAlphaMask <> AlphaMask) then
  2208. exit;
  2209. result := true;
  2210. end;
  2211. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2212. function TFormatDescriptor.MaskMatch(const aMask: TglBitmapMask): Boolean;
  2213. begin
  2214. result := MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a);
  2215. end;
  2216. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2217. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2218. begin
  2219. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2220. aPixel.Data := fRange;
  2221. aPixel.Range := fRange;
  2222. aPixel.Format := fFormat;
  2223. end;
  2224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2225. constructor TFormatDescriptor.Create;
  2226. begin
  2227. inherited Create;
  2228. fFormat := tfEmpty;
  2229. fWithAlpha := tfEmpty;
  2230. fWithoutAlpha := tfEmpty;
  2231. fOpenGLFormat := tfEmpty;
  2232. fRGBInverted := tfEmpty;
  2233. fUncompressed := tfEmpty;
  2234. fPixelSize := 0.0;
  2235. fIsCompressed := false;
  2236. fglFormat := 0;
  2237. fglInternalFormat := 0;
  2238. fglDataFormat := 0;
  2239. FillChar(fRange, 0, SizeOf(fRange));
  2240. FillChar(fShift, 0, SizeOf(fShift));
  2241. end;
  2242. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2243. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2244. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2245. procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2246. begin
  2247. aData^ := aPixel.Data.a;
  2248. inc(aData);
  2249. end;
  2250. procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2251. begin
  2252. aPixel.Data.r := 0;
  2253. aPixel.Data.g := 0;
  2254. aPixel.Data.b := 0;
  2255. aPixel.Data.a := aData^;
  2256. inc(aData);
  2257. end;
  2258. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2259. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2260. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2261. procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2262. begin
  2263. aData^ := LuminanceWeight(aPixel);
  2264. inc(aData);
  2265. end;
  2266. procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2267. begin
  2268. aPixel.Data.r := aData^;
  2269. aPixel.Data.g := aData^;
  2270. aPixel.Data.b := aData^;
  2271. aPixel.Data.a := 0;
  2272. inc(aData);
  2273. end;
  2274. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2275. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2276. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2277. procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2278. var
  2279. i: Integer;
  2280. begin
  2281. aData^ := 0;
  2282. for i := 0 to 3 do
  2283. if (fRange.arr[i] > 0) then
  2284. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2285. inc(aData);
  2286. end;
  2287. procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2288. var
  2289. i: Integer;
  2290. begin
  2291. for i := 0 to 3 do
  2292. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2293. inc(aData);
  2294. end;
  2295. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2296. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2297. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2298. procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2299. begin
  2300. inherited Map(aPixel, aData, aMapData);
  2301. aData^ := aPixel.Data.a;
  2302. inc(aData);
  2303. end;
  2304. procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2305. begin
  2306. inherited Unmap(aData, aPixel, aMapData);
  2307. aPixel.Data.a := aData^;
  2308. inc(aData);
  2309. end;
  2310. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2311. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2312. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2313. procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2314. begin
  2315. aData^ := aPixel.Data.r;
  2316. inc(aData);
  2317. aData^ := aPixel.Data.g;
  2318. inc(aData);
  2319. aData^ := aPixel.Data.b;
  2320. inc(aData);
  2321. end;
  2322. procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2323. begin
  2324. aPixel.Data.r := aData^;
  2325. inc(aData);
  2326. aPixel.Data.g := aData^;
  2327. inc(aData);
  2328. aPixel.Data.b := aData^;
  2329. inc(aData);
  2330. aPixel.Data.a := 0;
  2331. end;
  2332. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2333. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2334. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2335. procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2336. begin
  2337. aData^ := aPixel.Data.b;
  2338. inc(aData);
  2339. aData^ := aPixel.Data.g;
  2340. inc(aData);
  2341. aData^ := aPixel.Data.r;
  2342. inc(aData);
  2343. end;
  2344. procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2345. begin
  2346. aPixel.Data.b := aData^;
  2347. inc(aData);
  2348. aPixel.Data.g := aData^;
  2349. inc(aData);
  2350. aPixel.Data.r := aData^;
  2351. inc(aData);
  2352. aPixel.Data.a := 0;
  2353. end;
  2354. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2355. //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2356. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2357. procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2358. begin
  2359. inherited Map(aPixel, aData, aMapData);
  2360. aData^ := aPixel.Data.a;
  2361. inc(aData);
  2362. end;
  2363. procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2364. begin
  2365. inherited Unmap(aData, aPixel, aMapData);
  2366. aPixel.Data.a := aData^;
  2367. inc(aData);
  2368. end;
  2369. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2370. //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2371. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2372. procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2373. begin
  2374. inherited Map(aPixel, aData, aMapData);
  2375. aData^ := aPixel.Data.a;
  2376. inc(aData);
  2377. end;
  2378. procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2379. begin
  2380. inherited Unmap(aData, aPixel, aMapData);
  2381. aPixel.Data.a := aData^;
  2382. inc(aData);
  2383. end;
  2384. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2385. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2386. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2387. procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2388. begin
  2389. PWord(aData)^ := aPixel.Data.a;
  2390. inc(aData, 2);
  2391. end;
  2392. procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2393. begin
  2394. aPixel.Data.r := 0;
  2395. aPixel.Data.g := 0;
  2396. aPixel.Data.b := 0;
  2397. aPixel.Data.a := PWord(aData)^;
  2398. inc(aData, 2);
  2399. end;
  2400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2401. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2402. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2403. procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2404. begin
  2405. PWord(aData)^ := LuminanceWeight(aPixel);
  2406. inc(aData, 2);
  2407. end;
  2408. procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2409. begin
  2410. aPixel.Data.r := PWord(aData)^;
  2411. aPixel.Data.g := PWord(aData)^;
  2412. aPixel.Data.b := PWord(aData)^;
  2413. aPixel.Data.a := 0;
  2414. inc(aData, 2);
  2415. end;
  2416. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2417. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2418. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2419. procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2420. var
  2421. i: Integer;
  2422. begin
  2423. PWord(aData)^ := 0;
  2424. for i := 0 to 3 do
  2425. if (fRange.arr[i] > 0) then
  2426. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2427. inc(aData, 2);
  2428. end;
  2429. procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2430. var
  2431. i: Integer;
  2432. begin
  2433. for i := 0 to 3 do
  2434. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2435. inc(aData, 2);
  2436. end;
  2437. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2438. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2439. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2440. procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2441. begin
  2442. PWord(aData)^ := DepthWeight(aPixel);
  2443. inc(aData, 2);
  2444. end;
  2445. procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2446. begin
  2447. aPixel.Data.r := PWord(aData)^;
  2448. aPixel.Data.g := PWord(aData)^;
  2449. aPixel.Data.b := PWord(aData)^;
  2450. aPixel.Data.a := PWord(aData)^;;
  2451. inc(aData, 2);
  2452. end;
  2453. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2454. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2455. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2456. procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2457. begin
  2458. inherited Map(aPixel, aData, aMapData);
  2459. PWord(aData)^ := aPixel.Data.a;
  2460. inc(aData, 2);
  2461. end;
  2462. procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2463. begin
  2464. inherited Unmap(aData, aPixel, aMapData);
  2465. aPixel.Data.a := PWord(aData)^;
  2466. inc(aData, 2);
  2467. end;
  2468. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2469. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2470. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2471. procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2472. begin
  2473. PWord(aData)^ := aPixel.Data.r;
  2474. inc(aData, 2);
  2475. PWord(aData)^ := aPixel.Data.g;
  2476. inc(aData, 2);
  2477. PWord(aData)^ := aPixel.Data.b;
  2478. inc(aData, 2);
  2479. end;
  2480. procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2481. begin
  2482. aPixel.Data.r := PWord(aData)^;
  2483. inc(aData, 2);
  2484. aPixel.Data.g := PWord(aData)^;
  2485. inc(aData, 2);
  2486. aPixel.Data.b := PWord(aData)^;
  2487. inc(aData, 2);
  2488. aPixel.Data.a := 0;
  2489. end;
  2490. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2491. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2492. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2493. procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2494. begin
  2495. PWord(aData)^ := aPixel.Data.b;
  2496. inc(aData, 2);
  2497. PWord(aData)^ := aPixel.Data.g;
  2498. inc(aData, 2);
  2499. PWord(aData)^ := aPixel.Data.r;
  2500. inc(aData, 2);
  2501. end;
  2502. procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2503. begin
  2504. aPixel.Data.b := PWord(aData)^;
  2505. inc(aData, 2);
  2506. aPixel.Data.g := PWord(aData)^;
  2507. inc(aData, 2);
  2508. aPixel.Data.r := PWord(aData)^;
  2509. inc(aData, 2);
  2510. aPixel.Data.a := 0;
  2511. end;
  2512. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2513. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2514. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2515. procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2516. begin
  2517. inherited Map(aPixel, aData, aMapData);
  2518. PWord(aData)^ := aPixel.Data.a;
  2519. inc(aData, 2);
  2520. end;
  2521. procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2522. begin
  2523. inherited Unmap(aData, aPixel, aMapData);
  2524. aPixel.Data.a := PWord(aData)^;
  2525. inc(aData, 2);
  2526. end;
  2527. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2528. //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2529. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2530. procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2531. begin
  2532. PWord(aData)^ := aPixel.Data.a;
  2533. inc(aData, 2);
  2534. inherited Map(aPixel, aData, aMapData);
  2535. end;
  2536. procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2537. begin
  2538. aPixel.Data.a := PWord(aData)^;
  2539. inc(aData, 2);
  2540. inherited Unmap(aData, aPixel, aMapData);
  2541. end;
  2542. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2543. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2544. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2545. procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2546. begin
  2547. inherited Map(aPixel, aData, aMapData);
  2548. PWord(aData)^ := aPixel.Data.a;
  2549. inc(aData, 2);
  2550. end;
  2551. procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2552. begin
  2553. inherited Unmap(aData, aPixel, aMapData);
  2554. aPixel.Data.a := PWord(aData)^;
  2555. inc(aData, 2);
  2556. end;
  2557. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2558. //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2559. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2560. procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2561. begin
  2562. PWord(aData)^ := aPixel.Data.a;
  2563. inc(aData, 2);
  2564. inherited Map(aPixel, aData, aMapData);
  2565. end;
  2566. procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2567. begin
  2568. aPixel.Data.a := PWord(aData)^;
  2569. inc(aData, 2);
  2570. inherited Unmap(aData, aPixel, aMapData);
  2571. end;
  2572. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2573. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2574. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2575. procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2576. var
  2577. i: Integer;
  2578. begin
  2579. PCardinal(aData)^ := 0;
  2580. for i := 0 to 3 do
  2581. if (fRange.arr[i] > 0) then
  2582. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2583. inc(aData, 4);
  2584. end;
  2585. procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2586. var
  2587. i: Integer;
  2588. begin
  2589. for i := 0 to 3 do
  2590. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2591. inc(aData, 2);
  2592. end;
  2593. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2594. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2595. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2596. procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2597. begin
  2598. PCardinal(aData)^ := DepthWeight(aPixel);
  2599. inc(aData, 4);
  2600. end;
  2601. procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2602. begin
  2603. aPixel.Data.r := PCardinal(aData)^;
  2604. aPixel.Data.g := PCardinal(aData)^;
  2605. aPixel.Data.b := PCardinal(aData)^;
  2606. aPixel.Data.a := PCardinal(aData)^;
  2607. inc(aData, 4);
  2608. end;
  2609. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2610. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2611. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2612. constructor TfdAlpha4ub1.Create;
  2613. begin
  2614. inherited Create;
  2615. fPixelSize := 1.0;
  2616. fFormat := tfAlpha4ub1;
  2617. fWithAlpha := tfAlpha4ub1;
  2618. fOpenGLFormat := tfAlpha4ub1;
  2619. fRange.a := $FF;
  2620. fglFormat := GL_ALPHA;
  2621. fglInternalFormat := GL_ALPHA4;
  2622. fglDataFormat := GL_UNSIGNED_BYTE;
  2623. end;
  2624. constructor TfdAlpha8ub1.Create;
  2625. begin
  2626. inherited Create;
  2627. fPixelSize := 1.0;
  2628. fFormat := tfAlpha8ub1;
  2629. fWithAlpha := tfAlpha8ub1;
  2630. fOpenGLFormat := tfAlpha8ub1;
  2631. fRange.a := $FF;
  2632. fglFormat := GL_ALPHA;
  2633. fglInternalFormat := GL_ALPHA8;
  2634. fglDataFormat := GL_UNSIGNED_BYTE;
  2635. end;
  2636. constructor TfdAlpha16us1.Create;
  2637. begin
  2638. inherited Create;
  2639. fPixelSize := 2.0;
  2640. fFormat := tfAlpha16us1;
  2641. fWithAlpha := tfAlpha16us1;
  2642. fOpenGLFormat := tfAlpha16us1;
  2643. fRange.a := $FFFF;
  2644. fglFormat := GL_ALPHA;
  2645. fglInternalFormat := GL_ALPHA16;
  2646. fglDataFormat := GL_UNSIGNED_SHORT;
  2647. end;
  2648. constructor TfdLuminance4ub1.Create;
  2649. begin
  2650. inherited Create;
  2651. fPixelSize := 1.0;
  2652. fFormat := tfLuminance4ub1;
  2653. fWithAlpha := tfLuminance4Alpha4ub2;
  2654. fWithoutAlpha := tfLuminance4ub1;
  2655. fOpenGLFormat := tfLuminance4ub1;
  2656. fRange.r := $FF;
  2657. fRange.g := $FF;
  2658. fRange.b := $FF;
  2659. fglFormat := GL_LUMINANCE;
  2660. fglInternalFormat := GL_LUMINANCE4;
  2661. fglDataFormat := GL_UNSIGNED_BYTE;
  2662. end;
  2663. constructor TfdLuminance8ub1.Create;
  2664. begin
  2665. inherited Create;
  2666. fPixelSize := 1.0;
  2667. fFormat := tfLuminance8ub1;
  2668. fWithAlpha := tfLuminance8Alpha8ub2;
  2669. fWithoutAlpha := tfLuminance8ub1;
  2670. fOpenGLFormat := tfLuminance8ub1;
  2671. fRange.r := $FF;
  2672. fRange.g := $FF;
  2673. fRange.b := $FF;
  2674. fglFormat := GL_LUMINANCE;
  2675. fglInternalFormat := GL_LUMINANCE8;
  2676. fglDataFormat := GL_UNSIGNED_BYTE;
  2677. end;
  2678. constructor TfdLuminance16us1.Create;
  2679. begin
  2680. inherited Create;
  2681. fPixelSize := 2.0;
  2682. fFormat := tfLuminance16us1;
  2683. fWithAlpha := tfLuminance16Alpha16us2;
  2684. fWithoutAlpha := tfLuminance16us1;
  2685. fOpenGLFormat := tfLuminance16us1;
  2686. fRange.r := $FFFF;
  2687. fRange.g := $FFFF;
  2688. fRange.b := $FFFF;
  2689. fglFormat := GL_LUMINANCE;
  2690. fglInternalFormat := GL_LUMINANCE16;
  2691. fglDataFormat := GL_UNSIGNED_SHORT;
  2692. end;
  2693. constructor TfdLuminance4Alpha4ub2.Create;
  2694. begin
  2695. inherited Create;
  2696. fPixelSize := 2.0;
  2697. fFormat := tfLuminance4Alpha4ub2;
  2698. fWithAlpha := tfLuminance4Alpha4ub2;
  2699. fWithoutAlpha := tfLuminance4ub1;
  2700. fOpenGLFormat := tfLuminance4Alpha4ub2;
  2701. fRange.r := $FF;
  2702. fRange.g := $FF;
  2703. fRange.b := $FF;
  2704. fRange.a := $FF;
  2705. fShift.r := 0;
  2706. fShift.g := 0;
  2707. fShift.b := 0;
  2708. fShift.a := 8;
  2709. fglFormat := GL_LUMINANCE_ALPHA;
  2710. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2711. fglDataFormat := GL_UNSIGNED_BYTE;
  2712. end;
  2713. constructor TfdLuminance6Alpha2ub2.Create;
  2714. begin
  2715. inherited Create;
  2716. fPixelSize := 2.0;
  2717. fFormat := tfLuminance6Alpha2ub2;
  2718. fWithAlpha := tfLuminance6Alpha2ub2;
  2719. fWithoutAlpha := tfLuminance8ub1;
  2720. fOpenGLFormat := tfLuminance6Alpha2ub2;
  2721. fRange.r := $FF;
  2722. fRange.g := $FF;
  2723. fRange.b := $FF;
  2724. fRange.a := $FF;
  2725. fShift.r := 0;
  2726. fShift.g := 0;
  2727. fShift.b := 0;
  2728. fShift.a := 8;
  2729. fglFormat := GL_LUMINANCE_ALPHA;
  2730. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2731. fglDataFormat := GL_UNSIGNED_BYTE;
  2732. end;
  2733. constructor TfdLuminance8Alpha8ub2.Create;
  2734. begin
  2735. inherited Create;
  2736. fPixelSize := 2.0;
  2737. fFormat := tfLuminance8Alpha8ub2;
  2738. fWithAlpha := tfLuminance8Alpha8ub2;
  2739. fWithoutAlpha := tfLuminance8ub1;
  2740. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2741. fRange.r := $FF;
  2742. fRange.g := $FF;
  2743. fRange.b := $FF;
  2744. fRange.a := $FF;
  2745. fShift.r := 0;
  2746. fShift.g := 0;
  2747. fShift.b := 0;
  2748. fShift.a := 8;
  2749. fglFormat := GL_LUMINANCE_ALPHA;
  2750. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2751. fglDataFormat := GL_UNSIGNED_BYTE;
  2752. end;
  2753. constructor TfdLuminance12Alpha4us2.Create;
  2754. begin
  2755. inherited Create;
  2756. fPixelSize := 4.0;
  2757. fFormat := tfLuminance12Alpha4us2;
  2758. fWithAlpha := tfLuminance12Alpha4us2;
  2759. fWithoutAlpha := tfLuminance16us1;
  2760. fOpenGLFormat := tfLuminance12Alpha4us2;
  2761. fRange.r := $FFFF;
  2762. fRange.g := $FFFF;
  2763. fRange.b := $FFFF;
  2764. fRange.a := $FFFF;
  2765. fShift.r := 0;
  2766. fShift.g := 0;
  2767. fShift.b := 0;
  2768. fShift.a := 16;
  2769. fglFormat := GL_LUMINANCE_ALPHA;
  2770. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2771. fglDataFormat := GL_UNSIGNED_SHORT;
  2772. end;
  2773. constructor TfdLuminance16Alpha16us2.Create;
  2774. begin
  2775. inherited Create;
  2776. fPixelSize := 4.0;
  2777. fFormat := tfLuminance16Alpha16us2;
  2778. fWithAlpha := tfLuminance16Alpha16us2;
  2779. fWithoutAlpha := tfLuminance16us1;
  2780. fOpenGLFormat := tfLuminance16Alpha16us2;
  2781. fRange.r := $FFFF;
  2782. fRange.g := $FFFF;
  2783. fRange.b := $FFFF;
  2784. fRange.a := $FFFF;
  2785. fShift.r := 0;
  2786. fShift.g := 0;
  2787. fShift.b := 0;
  2788. fShift.a := 16;
  2789. fglFormat := GL_LUMINANCE_ALPHA;
  2790. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2791. fglDataFormat := GL_UNSIGNED_SHORT;
  2792. end;
  2793. constructor TfdR3G3B2ub1.Create;
  2794. begin
  2795. inherited Create;
  2796. fPixelSize := 1.0;
  2797. fFormat := tfR3G3B2ub1;
  2798. fWithAlpha := tfRGBA4us1;
  2799. fWithoutAlpha := tfR3G3B2ub1;
  2800. fOpenGLFormat := tfR3G3B2ub1;
  2801. fRGBInverted := tfEmpty;
  2802. fRange.r := $07;
  2803. fRange.g := $07;
  2804. fRange.b := $03;
  2805. fShift.r := 5;
  2806. fShift.g := 2;
  2807. fShift.b := 0;
  2808. fglFormat := GL_RGB;
  2809. fglInternalFormat := GL_R3_G3_B2;
  2810. fglDataFormat := GL_UNSIGNED_BYTE_3_3_2;
  2811. end;
  2812. constructor TfdRGBX4us1.Create;
  2813. begin
  2814. inherited Create;
  2815. fPixelSize := 2.0;
  2816. fFormat := tfRGBX4us1;
  2817. fWithAlpha := tfRGBA4us1;
  2818. fWithoutAlpha := tfRGBX4us1;
  2819. fOpenGLFormat := tfRGBX4us1;
  2820. fRGBInverted := tfBGRX4us1;
  2821. fRange.r := $0F;
  2822. fRange.g := $0F;
  2823. fRange.b := $0F;
  2824. fRange.a := $00;
  2825. fShift.r := 12;
  2826. fShift.g := 8;
  2827. fShift.b := 4;
  2828. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2829. fglInternalFormat := GL_RGB4;
  2830. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2831. end;
  2832. constructor TfdXRGB4us1.Create;
  2833. begin
  2834. inherited Create;
  2835. fPixelSize := 2.0;
  2836. fFormat := tfXRGB4us1;
  2837. fWithAlpha := tfARGB4us1;
  2838. fWithoutAlpha := tfXRGB4us1;
  2839. fOpenGLFormat := tfXRGB4us1;
  2840. fRGBInverted := tfXBGR4us1;
  2841. fRange.r := $0F;
  2842. fRange.g := $0F;
  2843. fRange.b := $0F;
  2844. fShift.r := 8;
  2845. fShift.g := 4;
  2846. fShift.b := 0;
  2847. fglFormat := GL_BGRA;
  2848. fglInternalFormat := GL_RGB4;
  2849. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2850. end;
  2851. constructor TfdR5G6B5us1.Create;
  2852. begin
  2853. inherited Create;
  2854. fPixelSize := 2.0;
  2855. fFormat := tfR5G6B5us1;
  2856. fWithAlpha := tfRGB5A1us1;
  2857. fWithoutAlpha := tfR5G6B5us1;
  2858. fOpenGLFormat := tfR5G6B5us1;
  2859. fRGBInverted := tfB5G6R5us1;
  2860. fRange.r := $1F;
  2861. fRange.g := $3F;
  2862. fRange.b := $1F;
  2863. fShift.r := 11;
  2864. fShift.g := 5;
  2865. fShift.b := 0;
  2866. fglFormat := GL_RGB;
  2867. fglInternalFormat := GL_RGB565;
  2868. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2869. end;
  2870. constructor TfdRGB5X1us1.Create;
  2871. begin
  2872. inherited Create;
  2873. fPixelSize := 2.0;
  2874. fFormat := tfRGB5X1us1;
  2875. fWithAlpha := tfRGB5A1us1;
  2876. fWithoutAlpha := tfRGB5X1us1;
  2877. fOpenGLFormat := tfRGB5X1us1;
  2878. fRGBInverted := tfBGR5X1us1;
  2879. fRange.r := $1F;
  2880. fRange.g := $1F;
  2881. fRange.b := $1F;
  2882. fShift.r := 11;
  2883. fShift.g := 6;
  2884. fShift.b := 1;
  2885. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2886. fglInternalFormat := GL_RGB5;
  2887. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2888. end;
  2889. constructor TfdX1RGB5us1.Create;
  2890. begin
  2891. inherited Create;
  2892. fPixelSize := 2.0;
  2893. fFormat := tfX1RGB5us1;
  2894. fWithAlpha := tfA1RGB5us1;
  2895. fWithoutAlpha := tfX1RGB5us1;
  2896. fOpenGLFormat := tfX1RGB5us1;
  2897. fRGBInverted := tfX1BGR5us1;
  2898. fRange.r := $1F;
  2899. fRange.g := $1F;
  2900. fRange.b := $1F;
  2901. fShift.r := 10;
  2902. fShift.g := 5;
  2903. fShift.b := 0;
  2904. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2905. fglInternalFormat := GL_RGB5;
  2906. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2907. end;
  2908. constructor TfdRGB8ub3.Create;
  2909. begin
  2910. inherited Create;
  2911. fPixelSize := 3.0;
  2912. fFormat := tfRGB8ub3;
  2913. fWithAlpha := tfRGBA8ub4;
  2914. fWithoutAlpha := tfRGB8ub3;
  2915. fOpenGLFormat := tfRGB8ub3;
  2916. fRGBInverted := tfBGR8ub3;
  2917. fRange.r := $FF;
  2918. fRange.g := $FF;
  2919. fRange.b := $FF;
  2920. fShift.r := 0;
  2921. fShift.g := 8;
  2922. fShift.b := 16;
  2923. fglFormat := GL_RGB;
  2924. fglInternalFormat := GL_RGB8;
  2925. fglDataFormat := GL_UNSIGNED_BYTE;
  2926. end;
  2927. constructor TfdRGBX8ui1.Create;
  2928. begin
  2929. inherited Create;
  2930. fPixelSize := 4.0;
  2931. fFormat := tfRGBX8ui1;
  2932. fWithAlpha := tfRGBA8ui1;
  2933. fWithoutAlpha := tfRGBX8ui1;
  2934. fOpenGLFormat := tfRGB8ub3;
  2935. fRGBInverted := tfBGRX8ui1;
  2936. fRange.r := $FF;
  2937. fRange.g := $FF;
  2938. fRange.b := $FF;
  2939. fShift.r := 24;
  2940. fShift.g := 16;
  2941. fShift.b := 8;
  2942. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2943. fglInternalFormat := GL_RGB8;
  2944. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2945. end;
  2946. constructor TfdXRGB8ui1.Create;
  2947. begin
  2948. inherited Create;
  2949. fPixelSize := 4.0;
  2950. fFormat := tfXRGB8ui1;
  2951. fWithAlpha := tfXRGB8ui1;
  2952. fWithoutAlpha := tfXRGB8ui1;
  2953. fOpenGLFormat := tfRGB8ub3;
  2954. fRGBInverted := tfXBGR8ui1;
  2955. fRange.r := $FF;
  2956. fRange.g := $FF;
  2957. fRange.b := $FF;
  2958. fShift.r := 16;
  2959. fShift.g := 8;
  2960. fShift.b := 0;
  2961. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2962. fglInternalFormat := GL_RGB8;
  2963. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2964. end;
  2965. constructor TfdRGB10X2ui1.Create;
  2966. begin
  2967. inherited Create;
  2968. fPixelSize := 4.0;
  2969. fFormat := tfRGB10X2ui1;
  2970. fWithAlpha := tfRGB10A2ui1;
  2971. fWithoutAlpha := tfRGB10X2ui1;
  2972. fOpenGLFormat := tfRGB10X2ui1;
  2973. fRGBInverted := tfBGR10X2ui1;
  2974. fRange.r := $03FF;
  2975. fRange.g := $03FF;
  2976. fRange.b := $03FF;
  2977. fShift.r := 22;
  2978. fShift.g := 12;
  2979. fShift.b := 2;
  2980. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2981. fglInternalFormat := GL_RGB10;
  2982. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2983. end;
  2984. constructor TfdX2RGB10ui1.Create;
  2985. begin
  2986. inherited Create;
  2987. fPixelSize := 4.0;
  2988. fFormat := tfX2RGB10ui1;
  2989. fWithAlpha := tfA2RGB10ui1;
  2990. fWithoutAlpha := tfX2RGB10ui1;
  2991. fOpenGLFormat := tfX2RGB10ui1;
  2992. fRGBInverted := tfX2BGR10ui1;
  2993. fRange.r := $03FF;
  2994. fRange.g := $03FF;
  2995. fRange.b := $03FF;
  2996. fShift.r := 20;
  2997. fShift.g := 10;
  2998. fShift.b := 0;
  2999. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3000. fglInternalFormat := GL_RGB10;
  3001. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3002. end;
  3003. constructor TfdRGB16us3.Create;
  3004. begin
  3005. inherited Create;
  3006. fPixelSize := 6.0;
  3007. fFormat := tfRGB16us3;
  3008. fWithAlpha := tfRGBA16us4;
  3009. fWithoutAlpha := tfRGB16us3;
  3010. fOpenGLFormat := tfRGB16us3;
  3011. fRGBInverted := tfBGR16us3;
  3012. fRange.r := $FFFF;
  3013. fRange.g := $FFFF;
  3014. fRange.b := $FFFF;
  3015. fShift.r := 0;
  3016. fShift.g := 16;
  3017. fShift.b := 32;
  3018. fglFormat := GL_RGB;
  3019. fglInternalFormat := GL_RGB16;
  3020. fglDataFormat := GL_UNSIGNED_SHORT;
  3021. end;
  3022. constructor TfdRGBA4us1.Create;
  3023. begin
  3024. inherited Create;
  3025. fPixelSize := 2.0;
  3026. fFormat := tfRGBA4us1;
  3027. fWithAlpha := tfRGBA4us1;
  3028. fWithoutAlpha := tfRGBX4us1;
  3029. fOpenGLFormat := tfRGBA4us1;
  3030. fRGBInverted := tfBGRA4us1;
  3031. fRange.r := $0F;
  3032. fRange.g := $0F;
  3033. fRange.b := $0F;
  3034. fRange.a := $0F;
  3035. fShift.r := 12;
  3036. fShift.g := 8;
  3037. fShift.b := 4;
  3038. fShift.a := 0;
  3039. fglFormat := GL_RGBA;
  3040. fglInternalFormat := GL_RGBA4;
  3041. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3042. end;
  3043. constructor TfdARGB4us1.Create;
  3044. begin
  3045. inherited Create;
  3046. fPixelSize := 2.0;
  3047. fFormat := tfARGB4us1;
  3048. fWithAlpha := tfARGB4us1;
  3049. fWithoutAlpha := tfXRGB4us1;
  3050. fOpenGLFormat := tfARGB4us1;
  3051. fRGBInverted := tfABGR4us1;
  3052. fRange.r := $0F;
  3053. fRange.g := $0F;
  3054. fRange.b := $0F;
  3055. fRange.a := $0F;
  3056. fShift.r := 8;
  3057. fShift.g := 4;
  3058. fShift.b := 0;
  3059. fShift.a := 12;
  3060. fglFormat := GL_BGRA;
  3061. fglInternalFormat := GL_RGBA4;
  3062. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3063. end;
  3064. constructor TfdRGB5A1us1.Create;
  3065. begin
  3066. inherited Create;
  3067. fPixelSize := 2.0;
  3068. fFormat := tfRGB5A1us1;
  3069. fWithAlpha := tfRGB5A1us1;
  3070. fWithoutAlpha := tfRGB5X1us1;
  3071. fOpenGLFormat := tfRGB5A1us1;
  3072. fRGBInverted := tfBGR5A1us1;
  3073. fRange.r := $1F;
  3074. fRange.g := $1F;
  3075. fRange.b := $1F;
  3076. fRange.a := $01;
  3077. fShift.r := 11;
  3078. fShift.g := 6;
  3079. fShift.b := 1;
  3080. fShift.a := 0;
  3081. fglFormat := GL_RGBA;
  3082. fglInternalFormat := GL_RGB5_A1;
  3083. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3084. end;
  3085. constructor TfdA1RGB5us1.Create;
  3086. begin
  3087. inherited Create;
  3088. fPixelSize := 2.0;
  3089. fFormat := tfA1RGB5us1;
  3090. fWithAlpha := tfA1RGB5us1;
  3091. fWithoutAlpha := tfX1RGB5us1;
  3092. fOpenGLFormat := tfA1RGB5us1;
  3093. fRGBInverted := tfA1BGR5us1;
  3094. fRange.r := $1F;
  3095. fRange.g := $1F;
  3096. fRange.b := $1F;
  3097. fRange.a := $01;
  3098. fShift.r := 10;
  3099. fShift.g := 5;
  3100. fShift.b := 0;
  3101. fShift.a := 15;
  3102. fglFormat := GL_BGRA;
  3103. fglInternalFormat := GL_RGB5_A1;
  3104. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3105. end;
  3106. constructor TfdRGBA8ui1.Create;
  3107. begin
  3108. inherited Create;
  3109. fPixelSize := 4.0;
  3110. fFormat := tfRGBA8ui1;
  3111. fWithAlpha := tfRGBA8ui1;
  3112. fWithoutAlpha := tfRGBX8ui1;
  3113. fOpenGLFormat := tfRGBA8ui1;
  3114. fRGBInverted := tfBGRA8ui1;
  3115. fRange.r := $FF;
  3116. fRange.g := $FF;
  3117. fRange.b := $FF;
  3118. fRange.a := $FF;
  3119. fShift.r := 24;
  3120. fShift.g := 16;
  3121. fShift.b := 8;
  3122. fShift.a := 0;
  3123. fglFormat := GL_RGBA;
  3124. fglInternalFormat := GL_RGBA8;
  3125. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3126. end;
  3127. constructor TfdARGB8ui1.Create;
  3128. begin
  3129. inherited Create;
  3130. fPixelSize := 4.0;
  3131. fFormat := tfARGB8ui1;
  3132. fWithAlpha := tfARGB8ui1;
  3133. fWithoutAlpha := tfXRGB8ui1;
  3134. fOpenGLFormat := tfARGB8ui1;
  3135. fRGBInverted := tfABGR8ui1;
  3136. fRange.r := $FF;
  3137. fRange.g := $FF;
  3138. fRange.b := $FF;
  3139. fRange.a := $FF;
  3140. fShift.r := 16;
  3141. fShift.g := 8;
  3142. fShift.b := 0;
  3143. fShift.a := 24;
  3144. fglFormat := GL_BGRA;
  3145. fglInternalFormat := GL_RGBA8;
  3146. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3147. end;
  3148. constructor TfdRGBA8ub4.Create;
  3149. begin
  3150. inherited Create;
  3151. fPixelSize := 4.0;
  3152. fFormat := tfRGBA8ub4;
  3153. fWithAlpha := tfRGBA8ub4;
  3154. fWithoutAlpha := tfRGB8ub3;
  3155. fOpenGLFormat := tfRGBA8ub4;
  3156. fRGBInverted := tfBGRA8ub4;
  3157. fRange.r := $FF;
  3158. fRange.g := $FF;
  3159. fRange.b := $FF;
  3160. fRange.a := $FF;
  3161. fShift.r := 0;
  3162. fShift.g := 8;
  3163. fShift.b := 16;
  3164. fShift.a := 24;
  3165. fglFormat := GL_RGBA;
  3166. fglInternalFormat := GL_RGBA8;
  3167. fglDataFormat := GL_UNSIGNED_BYTE;
  3168. end;
  3169. constructor TfdRGB10A2ui1.Create;
  3170. begin
  3171. inherited Create;
  3172. fPixelSize := 4.0;
  3173. fFormat := tfRGB10A2ui1;
  3174. fWithAlpha := tfRGB10A2ui1;
  3175. fWithoutAlpha := tfRGB10X2ui1;
  3176. fOpenGLFormat := tfRGB10A2ui1;
  3177. fRGBInverted := tfBGR10A2ui1;
  3178. fRange.r := $03FF;
  3179. fRange.g := $03FF;
  3180. fRange.b := $03FF;
  3181. fRange.a := $0003;
  3182. fShift.r := 22;
  3183. fShift.g := 12;
  3184. fShift.b := 2;
  3185. fShift.a := 0;
  3186. fglFormat := GL_RGBA;
  3187. fglInternalFormat := GL_RGB10_A2;
  3188. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3189. end;
  3190. constructor TfdA2RGB10ui1.Create;
  3191. begin
  3192. inherited Create;
  3193. fPixelSize := 4.0;
  3194. fFormat := tfA2RGB10ui1;
  3195. fWithAlpha := tfA2RGB10ui1;
  3196. fWithoutAlpha := tfX2RGB10ui1;
  3197. fOpenGLFormat := tfA2RGB10ui1;
  3198. fRGBInverted := tfA2BGR10ui1;
  3199. fRange.r := $03FF;
  3200. fRange.g := $03FF;
  3201. fRange.b := $03FF;
  3202. fRange.a := $0003;
  3203. fShift.r := 20;
  3204. fShift.g := 10;
  3205. fShift.b := 0;
  3206. fShift.a := 30;
  3207. fglFormat := GL_BGRA;
  3208. fglInternalFormat := GL_RGB10_A2;
  3209. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3210. end;
  3211. constructor TfdRGBA16us4.Create;
  3212. begin
  3213. inherited Create;
  3214. fPixelSize := 8.0;
  3215. fFormat := tfRGBA16us4;
  3216. fWithAlpha := tfRGBA16us4;
  3217. fWithoutAlpha := tfRGB16us3;
  3218. fOpenGLFormat := tfRGBA16us4;
  3219. fRGBInverted := tfBGRA16us4;
  3220. fRange.r := $FFFF;
  3221. fRange.g := $FFFF;
  3222. fRange.b := $FFFF;
  3223. fRange.a := $FFFF;
  3224. fShift.r := 0;
  3225. fShift.g := 16;
  3226. fShift.b := 32;
  3227. fShift.a := 48;
  3228. fglFormat := GL_RGBA;
  3229. fglInternalFormat := GL_RGBA16;
  3230. fglDataFormat := GL_UNSIGNED_SHORT;
  3231. end;
  3232. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3233. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3234. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3235. constructor TfdBGRX4us1.Create;
  3236. begin
  3237. inherited Create;
  3238. fPixelSize := 2.0;
  3239. fFormat := tfBGRX4us1;
  3240. fWithAlpha := tfBGRA4us1;
  3241. fWithoutAlpha := tfBGRX4us1;
  3242. fOpenGLFormat := tfBGRX4us1;
  3243. fRGBInverted := tfRGBX4us1;
  3244. fRange.r := $0F;
  3245. fRange.g := $0F;
  3246. fRange.b := $0F;
  3247. fShift.r := 4;
  3248. fShift.g := 8;
  3249. fShift.b := 12;
  3250. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3251. fglInternalFormat := GL_RGB4;
  3252. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3253. end;
  3254. constructor TfdXBGR4us1.Create;
  3255. begin
  3256. inherited Create;
  3257. fPixelSize := 2.0;
  3258. fFormat := tfXBGR4us1;
  3259. fWithAlpha := tfABGR4us1;
  3260. fWithoutAlpha := tfXBGR4us1;
  3261. fOpenGLFormat := tfXBGR4us1;
  3262. fRGBInverted := tfXRGB4us1;
  3263. fRange.r := $0F;
  3264. fRange.g := $0F;
  3265. fRange.b := $0F;
  3266. fShift.r := 0;
  3267. fShift.g := 4;
  3268. fShift.b := 8;
  3269. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3270. fglInternalFormat := GL_RGB4;
  3271. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3272. end;
  3273. constructor TfdB5G6R5us1.Create;
  3274. begin
  3275. inherited Create;
  3276. fPixelSize := 2.0;
  3277. fFormat := tfB5G6R5us1;
  3278. fWithAlpha := tfBGR5A1us1;
  3279. fWithoutAlpha := tfB5G6R5us1;
  3280. fOpenGLFormat := tfB5G6R5us1;
  3281. fRGBInverted := tfR5G6B5us1;
  3282. fRange.r := $1F;
  3283. fRange.g := $3F;
  3284. fRange.b := $1F;
  3285. fShift.r := 0;
  3286. fShift.g := 5;
  3287. fShift.b := 11;
  3288. fglFormat := GL_RGB;
  3289. fglInternalFormat := GL_RGB565;
  3290. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  3291. end;
  3292. constructor TfdBGR5X1us1.Create;
  3293. begin
  3294. inherited Create;
  3295. fPixelSize := 2.0;
  3296. fFormat := tfBGR5X1us1;
  3297. fWithAlpha := tfBGR5A1us1;
  3298. fWithoutAlpha := tfBGR5X1us1;
  3299. fOpenGLFormat := tfBGR5X1us1;
  3300. fRGBInverted := tfRGB5X1us1;
  3301. fRange.r := $1F;
  3302. fRange.g := $1F;
  3303. fRange.b := $1F;
  3304. fShift.r := 1;
  3305. fShift.g := 6;
  3306. fShift.b := 11;
  3307. fglFormat := GL_BGRA;
  3308. fglInternalFormat := GL_RGB5;
  3309. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3310. end;
  3311. constructor TfdX1BGR5us1.Create;
  3312. begin
  3313. inherited Create;
  3314. fPixelSize := 2.0;
  3315. fFormat := tfX1BGR5us1;
  3316. fWithAlpha := tfA1BGR5us1;
  3317. fWithoutAlpha := tfX1BGR5us1;
  3318. fOpenGLFormat := tfX1BGR5us1;
  3319. fRGBInverted := tfX1RGB5us1;
  3320. fRange.r := $1F;
  3321. fRange.g := $1F;
  3322. fRange.b := $1F;
  3323. fShift.r := 0;
  3324. fShift.g := 5;
  3325. fShift.b := 10;
  3326. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3327. fglInternalFormat := GL_RGB5;
  3328. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3329. end;
  3330. constructor TfdBGR8ub3.Create;
  3331. begin
  3332. inherited Create;
  3333. fPixelSize := 3.0;
  3334. fFormat := tfBGR8ub3;
  3335. fWithAlpha := tfBGRA8ub4;
  3336. fWithoutAlpha := tfBGR8ub3;
  3337. fOpenGLFormat := tfBGR8ub3;
  3338. fRGBInverted := tfRGB8ub3;
  3339. fRange.r := $FF;
  3340. fRange.g := $FF;
  3341. fRange.b := $FF;
  3342. fShift.r := 16;
  3343. fShift.g := 8;
  3344. fShift.b := 0;
  3345. fglFormat := GL_BGR;
  3346. fglInternalFormat := GL_RGB8;
  3347. fglDataFormat := GL_UNSIGNED_BYTE;
  3348. end;
  3349. constructor TfdBGRX8ui1.Create;
  3350. begin
  3351. inherited Create;
  3352. fPixelSize := 4.0;
  3353. fFormat := tfBGRX8ui1;
  3354. fWithAlpha := tfBGRA8ui1;
  3355. fWithoutAlpha := tfBGRX8ui1;
  3356. fOpenGLFormat := tfBGRX8ui1;
  3357. fRGBInverted := tfRGBX8ui1;
  3358. fRange.r := $FF;
  3359. fRange.g := $FF;
  3360. fRange.b := $FF;
  3361. fShift.r := 8;
  3362. fShift.g := 16;
  3363. fShift.b := 24;
  3364. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3365. fglInternalFormat := GL_RGB8;
  3366. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3367. end;
  3368. constructor TfdXBGR8ui1.Create;
  3369. begin
  3370. inherited Create;
  3371. fPixelSize := 4.0;
  3372. fFormat := tfXBGR8ui1;
  3373. fWithAlpha := tfABGR8ui1;
  3374. fWithoutAlpha := tfXBGR8ui1;
  3375. fOpenGLFormat := tfXBGR8ui1;
  3376. fRGBInverted := tfXRGB8ui1;
  3377. fRange.r := $FF;
  3378. fRange.g := $FF;
  3379. fRange.b := $FF;
  3380. fShift.r := 0;
  3381. fShift.g := 8;
  3382. fShift.b := 16;
  3383. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3384. fglInternalFormat := GL_RGB8;
  3385. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3386. end;
  3387. constructor TfdBGR10X2ui1.Create;
  3388. begin
  3389. inherited Create;
  3390. fPixelSize := 4.0;
  3391. fFormat := tfBGR10X2ui1;
  3392. fWithAlpha := tfBGR10A2ui1;
  3393. fWithoutAlpha := tfBGR10X2ui1;
  3394. fOpenGLFormat := tfBGR10X2ui1;
  3395. fRGBInverted := tfRGB10X2ui1;
  3396. fRange.r := $03FF;
  3397. fRange.g := $03FF;
  3398. fRange.b := $03FF;
  3399. fShift.r := 2;
  3400. fShift.g := 12;
  3401. fShift.b := 22;
  3402. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3403. fglInternalFormat := GL_RGB10;
  3404. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3405. end;
  3406. constructor TfdX2BGR10ui1.Create;
  3407. begin
  3408. inherited Create;
  3409. fPixelSize := 4.0;
  3410. fFormat := tfX2BGR10ui1;
  3411. fWithAlpha := tfA2BGR10ui1;
  3412. fWithoutAlpha := tfX2BGR10ui1;
  3413. fOpenGLFormat := tfX2BGR10ui1;
  3414. fRGBInverted := tfX2RGB10ui1;
  3415. fRange.r := $03FF;
  3416. fRange.g := $03FF;
  3417. fRange.b := $03FF;
  3418. fShift.r := 0;
  3419. fShift.g := 10;
  3420. fShift.b := 20;
  3421. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3422. fglInternalFormat := GL_RGB10;
  3423. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3424. end;
  3425. constructor TfdBGR16us3.Create;
  3426. begin
  3427. inherited Create;
  3428. fPixelSize := 6.0;
  3429. fFormat := tfBGR16us3;
  3430. fWithAlpha := tfBGRA16us4;
  3431. fWithoutAlpha := tfBGR16us3;
  3432. fOpenGLFormat := tfBGR16us3;
  3433. fRGBInverted := tfRGB16us3;
  3434. fRange.r := $FFFF;
  3435. fRange.g := $FFFF;
  3436. fRange.b := $FFFF;
  3437. fShift.r := 32;
  3438. fShift.g := 16;
  3439. fShift.b := 0;
  3440. fglFormat := GL_BGR;
  3441. fglInternalFormat := GL_RGB16;
  3442. fglDataFormat := GL_UNSIGNED_SHORT;
  3443. end;
  3444. constructor TfdBGRA4us1.Create;
  3445. begin
  3446. inherited Create;
  3447. fPixelSize := 2.0;
  3448. fFormat := tfBGRA4us1;
  3449. fWithAlpha := tfBGRA4us1;
  3450. fWithoutAlpha := tfBGRX4us1;
  3451. fOpenGLFormat := tfBGRA4us1;
  3452. fRGBInverted := tfRGBA4us1;
  3453. fRange.r := $0F;
  3454. fRange.g := $0F;
  3455. fRange.b := $0F;
  3456. fRange.a := $0F;
  3457. fShift.r := 4;
  3458. fShift.g := 8;
  3459. fShift.b := 12;
  3460. fShift.a := 0;
  3461. fglFormat := GL_BGRA;
  3462. fglInternalFormat := GL_RGBA4;
  3463. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3464. end;
  3465. constructor TfdABGR4us1.Create;
  3466. begin
  3467. inherited Create;
  3468. fPixelSize := 2.0;
  3469. fFormat := tfABGR4us1;
  3470. fWithAlpha := tfABGR4us1;
  3471. fWithoutAlpha := tfXBGR4us1;
  3472. fOpenGLFormat := tfABGR4us1;
  3473. fRGBInverted := tfARGB4us1;
  3474. fRange.r := $0F;
  3475. fRange.g := $0F;
  3476. fRange.b := $0F;
  3477. fRange.a := $0F;
  3478. fShift.r := 0;
  3479. fShift.g := 4;
  3480. fShift.b := 8;
  3481. fShift.a := 12;
  3482. fglFormat := GL_RGBA;
  3483. fglInternalFormat := GL_RGBA4;
  3484. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3485. end;
  3486. constructor TfdBGR5A1us1.Create;
  3487. begin
  3488. inherited Create;
  3489. fPixelSize := 2.0;
  3490. fFormat := tfBGR5A1us1;
  3491. fWithAlpha := tfBGR5A1us1;
  3492. fWithoutAlpha := tfBGR5X1us1;
  3493. fOpenGLFormat := tfBGR5A1us1;
  3494. fRGBInverted := tfRGB5A1us1;
  3495. fRange.r := $1F;
  3496. fRange.g := $1F;
  3497. fRange.b := $1F;
  3498. fRange.a := $01;
  3499. fShift.r := 1;
  3500. fShift.g := 6;
  3501. fShift.b := 11;
  3502. fShift.a := 0;
  3503. fglFormat := GL_BGRA;
  3504. fglInternalFormat := GL_RGB5_A1;
  3505. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3506. end;
  3507. constructor TfdA1BGR5us1.Create;
  3508. begin
  3509. inherited Create;
  3510. fPixelSize := 2.0;
  3511. fFormat := tfA1BGR5us1;
  3512. fWithAlpha := tfA1BGR5us1;
  3513. fWithoutAlpha := tfX1BGR5us1;
  3514. fOpenGLFormat := tfA1BGR5us1;
  3515. fRGBInverted := tfA1RGB5us1;
  3516. fRange.r := $1F;
  3517. fRange.g := $1F;
  3518. fRange.b := $1F;
  3519. fRange.a := $01;
  3520. fShift.r := 0;
  3521. fShift.g := 5;
  3522. fShift.b := 10;
  3523. fShift.a := 15;
  3524. fglFormat := GL_RGBA;
  3525. fglInternalFormat := GL_RGB5_A1;
  3526. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3527. end;
  3528. constructor TfdBGRA8ui1.Create;
  3529. begin
  3530. inherited Create;
  3531. fPixelSize := 4.0;
  3532. fFormat := tfBGRA8ui1;
  3533. fWithAlpha := tfBGRA8ui1;
  3534. fWithoutAlpha := tfBGRX8ui1;
  3535. fOpenGLFormat := tfBGRA8ui1;
  3536. fRGBInverted := tfRGBA8ui1;
  3537. fRange.r := $FF;
  3538. fRange.g := $FF;
  3539. fRange.b := $FF;
  3540. fRange.a := $FF;
  3541. fShift.r := 8;
  3542. fShift.g := 16;
  3543. fShift.b := 24;
  3544. fShift.a := 0;
  3545. fglFormat := GL_BGRA;
  3546. fglInternalFormat := GL_RGBA8;
  3547. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3548. end;
  3549. constructor TfdABGR8ui1.Create;
  3550. begin
  3551. inherited Create;
  3552. fPixelSize := 4.0;
  3553. fFormat := tfABGR8ui1;
  3554. fWithAlpha := tfABGR8ui1;
  3555. fWithoutAlpha := tfXBGR8ui1;
  3556. fOpenGLFormat := tfABGR8ui1;
  3557. fRGBInverted := tfARGB8ui1;
  3558. fRange.r := $FF;
  3559. fRange.g := $FF;
  3560. fRange.b := $FF;
  3561. fRange.a := $FF;
  3562. fShift.r := 0;
  3563. fShift.g := 8;
  3564. fShift.b := 16;
  3565. fShift.a := 24;
  3566. fglFormat := GL_RGBA;
  3567. fglInternalFormat := GL_RGBA8;
  3568. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3569. end;
  3570. constructor TfdBGRA8ub4.Create;
  3571. begin
  3572. inherited Create;
  3573. fPixelSize := 4.0;
  3574. fFormat := tfBGRA8ub4;
  3575. fWithAlpha := tfBGRA8ub4;
  3576. fWithoutAlpha := tfBGR8ub3;
  3577. fOpenGLFormat := tfBGRA8ub4;
  3578. fRGBInverted := tfRGBA8ub4;
  3579. fRange.r := $FF;
  3580. fRange.g := $FF;
  3581. fRange.b := $FF;
  3582. fRange.a := $FF;
  3583. fShift.r := 16;
  3584. fShift.g := 8;
  3585. fShift.b := 0;
  3586. fShift.a := 24;
  3587. fglFormat := GL_BGRA;
  3588. fglInternalFormat := GL_RGBA8;
  3589. fglDataFormat := GL_UNSIGNED_BYTE;
  3590. end;
  3591. constructor TfdBGR10A2ui1.Create;
  3592. begin
  3593. inherited Create;
  3594. fPixelSize := 4.0;
  3595. fFormat := tfBGR10A2ui1;
  3596. fWithAlpha := tfBGR10A2ui1;
  3597. fWithoutAlpha := tfBGR10X2ui1;
  3598. fOpenGLFormat := tfBGR10A2ui1;
  3599. fRGBInverted := tfRGB10A2ui1;
  3600. fRange.r := $03FF;
  3601. fRange.g := $03FF;
  3602. fRange.b := $03FF;
  3603. fRange.a := $0003;
  3604. fShift.r := 2;
  3605. fShift.g := 12;
  3606. fShift.b := 22;
  3607. fShift.a := 0;
  3608. fglFormat := GL_BGRA;
  3609. fglInternalFormat := GL_RGB10_A2;
  3610. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3611. end;
  3612. constructor TfdA2BGR10ui1.Create;
  3613. begin
  3614. inherited Create;
  3615. fPixelSize := 4.0;
  3616. fFormat := tfA2BGR10ui1;
  3617. fWithAlpha := tfA2BGR10ui1;
  3618. fWithoutAlpha := tfX2BGR10ui1;
  3619. fOpenGLFormat := tfA2BGR10ui1;
  3620. fRGBInverted := tfA2RGB10ui1;
  3621. fRange.r := $03FF;
  3622. fRange.g := $03FF;
  3623. fRange.b := $03FF;
  3624. fRange.a := $0003;
  3625. fShift.r := 0;
  3626. fShift.g := 10;
  3627. fShift.b := 20;
  3628. fShift.a := 30;
  3629. fglFormat := GL_RGBA;
  3630. fglInternalFormat := GL_RGB10_A2;
  3631. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3632. end;
  3633. constructor TfdBGRA16us4.Create;
  3634. begin
  3635. inherited Create;
  3636. fPixelSize := 8.0;
  3637. fFormat := tfBGRA16us4;
  3638. fWithAlpha := tfBGRA16us4;
  3639. fWithoutAlpha := tfBGR16us3;
  3640. fOpenGLFormat := tfBGRA16us4;
  3641. fRGBInverted := tfRGBA16us4;
  3642. fRange.r := $FFFF;
  3643. fRange.g := $FFFF;
  3644. fRange.b := $FFFF;
  3645. fRange.a := $FFFF;
  3646. fShift.r := 32;
  3647. fShift.g := 16;
  3648. fShift.b := 0;
  3649. fShift.a := 48;
  3650. fglFormat := GL_BGRA;
  3651. fglInternalFormat := GL_RGBA16;
  3652. fglDataFormat := GL_UNSIGNED_SHORT;
  3653. end;
  3654. constructor TfdDepth16us1.Create;
  3655. begin
  3656. inherited Create;
  3657. fPixelSize := 2.0;
  3658. fFormat := tfDepth16us1;
  3659. fWithoutAlpha := tfDepth16us1;
  3660. fOpenGLFormat := tfDepth16us1;
  3661. fRange.r := $FFFF;
  3662. fRange.g := $FFFF;
  3663. fRange.b := $FFFF;
  3664. fRange.a := $FFFF;
  3665. fglFormat := GL_DEPTH_COMPONENT;
  3666. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3667. fglDataFormat := GL_UNSIGNED_SHORT;
  3668. end;
  3669. constructor TfdDepth24ui1.Create;
  3670. begin
  3671. inherited Create;
  3672. fPixelSize := 4.0;
  3673. fFormat := tfDepth24ui1;
  3674. fWithoutAlpha := tfDepth24ui1;
  3675. fOpenGLFormat := tfDepth24ui1;
  3676. fRange.r := $FFFFFFFF;
  3677. fRange.g := $FFFFFFFF;
  3678. fRange.b := $FFFFFFFF;
  3679. fRange.a := $FFFFFFFF;
  3680. fglFormat := GL_DEPTH_COMPONENT;
  3681. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3682. fglDataFormat := GL_UNSIGNED_INT;
  3683. end;
  3684. constructor TfdDepth32ui1.Create;
  3685. begin
  3686. inherited Create;
  3687. fPixelSize := 4.0;
  3688. fFormat := tfDepth32ui1;
  3689. fWithoutAlpha := tfDepth32ui1;
  3690. fOpenGLFormat := tfDepth32ui1;
  3691. fRange.r := $FFFFFFFF;
  3692. fRange.g := $FFFFFFFF;
  3693. fRange.b := $FFFFFFFF;
  3694. fRange.a := $FFFFFFFF;
  3695. fglFormat := GL_DEPTH_COMPONENT;
  3696. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3697. fglDataFormat := GL_UNSIGNED_INT;
  3698. end;
  3699. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3700. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3701. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3702. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3703. begin
  3704. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3705. end;
  3706. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3707. begin
  3708. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3709. end;
  3710. constructor TfdS3tcDtx1RGBA.Create;
  3711. begin
  3712. inherited Create;
  3713. fFormat := tfS3tcDtx1RGBA;
  3714. fWithAlpha := tfS3tcDtx1RGBA;
  3715. fOpenGLFormat := tfS3tcDtx1RGBA;
  3716. fUncompressed := tfRGB5A1us1;
  3717. fPixelSize := 0.5;
  3718. fIsCompressed := true;
  3719. fglFormat := GL_COMPRESSED_RGBA;
  3720. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3721. fglDataFormat := GL_UNSIGNED_BYTE;
  3722. end;
  3723. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3724. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3725. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3726. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3727. begin
  3728. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3729. end;
  3730. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3731. begin
  3732. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3733. end;
  3734. constructor TfdS3tcDtx3RGBA.Create;
  3735. begin
  3736. inherited Create;
  3737. fFormat := tfS3tcDtx3RGBA;
  3738. fWithAlpha := tfS3tcDtx3RGBA;
  3739. fOpenGLFormat := tfS3tcDtx3RGBA;
  3740. fUncompressed := tfRGBA8ub4;
  3741. fPixelSize := 1.0;
  3742. fIsCompressed := true;
  3743. fglFormat := GL_COMPRESSED_RGBA;
  3744. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3745. fglDataFormat := GL_UNSIGNED_BYTE;
  3746. end;
  3747. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3748. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3749. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3750. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3751. begin
  3752. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3753. end;
  3754. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3755. begin
  3756. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3757. end;
  3758. constructor TfdS3tcDtx5RGBA.Create;
  3759. begin
  3760. inherited Create;
  3761. fFormat := tfS3tcDtx3RGBA;
  3762. fWithAlpha := tfS3tcDtx3RGBA;
  3763. fOpenGLFormat := tfS3tcDtx3RGBA;
  3764. fUncompressed := tfRGBA8ub4;
  3765. fPixelSize := 1.0;
  3766. fIsCompressed := true;
  3767. fglFormat := GL_COMPRESSED_RGBA;
  3768. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3769. fglDataFormat := GL_UNSIGNED_BYTE;
  3770. end;
  3771. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3772. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3773. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3774. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3775. var
  3776. f: TglBitmapFormat;
  3777. begin
  3778. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3779. result := TFormatDescriptor.Get(f);
  3780. if (result.glInternalFormat = aInternalFormat) then
  3781. exit;
  3782. end;
  3783. result := TFormatDescriptor.Get(tfEmpty);
  3784. end;
  3785. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3786. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3787. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3788. class procedure TFormatDescriptor.Init;
  3789. begin
  3790. if not Assigned(FormatDescriptorCS) then
  3791. FormatDescriptorCS := TCriticalSection.Create;
  3792. end;
  3793. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3794. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3795. begin
  3796. FormatDescriptorCS.Enter;
  3797. try
  3798. result := FormatDescriptors[aFormat];
  3799. if not Assigned(result) then begin
  3800. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3801. FormatDescriptors[aFormat] := result;
  3802. end;
  3803. finally
  3804. FormatDescriptorCS.Leave;
  3805. end;
  3806. end;
  3807. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3808. class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3809. begin
  3810. result := Get(Get(aFormat).WithAlpha);
  3811. end;
  3812. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3813. class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapMask; const aBitCount: Integer): TFormatDescriptor;
  3814. var
  3815. ft: TglBitmapFormat;
  3816. begin
  3817. // find matching format with OpenGL support
  3818. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3819. result := Get(ft);
  3820. if (result.MaskMatch(aMask)) and
  3821. (result.glFormat <> 0) and
  3822. (result.glInternalFormat <> 0) and
  3823. ((aBitCount = 0) or (aBitCount = 8 * result.PixelSize))
  3824. then
  3825. exit;
  3826. end;
  3827. // find matching format without OpenGL Support
  3828. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3829. result := Get(ft);
  3830. if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = 8 * result.PixelSize)) then
  3831. exit;
  3832. end;
  3833. result := FormatDescriptors[tfEmpty];
  3834. end;
  3835. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3836. class procedure TFormatDescriptor.Clear;
  3837. var
  3838. f: TglBitmapFormat;
  3839. begin
  3840. FormatDescriptorCS.Enter;
  3841. try
  3842. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3843. FreeAndNil(FormatDescriptors[f]);
  3844. finally
  3845. FormatDescriptorCS.Leave;
  3846. end;
  3847. end;
  3848. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3849. class procedure TFormatDescriptor.Finalize;
  3850. begin
  3851. Clear;
  3852. FreeAndNil(FormatDescriptorCS);
  3853. end;
  3854. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3855. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3856. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3857. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3858. begin
  3859. Update(aValue, fRange.r, fShift.r);
  3860. end;
  3861. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3862. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3863. begin
  3864. Update(aValue, fRange.g, fShift.g);
  3865. end;
  3866. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3867. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3868. begin
  3869. Update(aValue, fRange.b, fShift.b);
  3870. end;
  3871. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3872. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3873. begin
  3874. Update(aValue, fRange.a, fShift.a);
  3875. end;
  3876. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3877. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3878. aShift: Byte);
  3879. begin
  3880. aShift := 0;
  3881. aRange := 0;
  3882. if (aMask = 0) then
  3883. exit;
  3884. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3885. inc(aShift);
  3886. aMask := aMask shr 1;
  3887. end;
  3888. aRange := 1;
  3889. while (aMask > 0) do begin
  3890. aRange := aRange shl 1;
  3891. aMask := aMask shr 1;
  3892. end;
  3893. dec(aRange);
  3894. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3895. end;
  3896. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3897. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3898. var
  3899. data: QWord;
  3900. s: Integer;
  3901. begin
  3902. data :=
  3903. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3904. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3905. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3906. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3907. s := Round(fPixelSize);
  3908. case s of
  3909. 1: aData^ := data;
  3910. 2: PWord(aData)^ := data;
  3911. 4: PCardinal(aData)^ := data;
  3912. 8: PQWord(aData)^ := data;
  3913. else
  3914. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3915. end;
  3916. inc(aData, s);
  3917. end;
  3918. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3919. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3920. var
  3921. data: QWord;
  3922. s, i: Integer;
  3923. begin
  3924. s := Round(fPixelSize);
  3925. case s of
  3926. 1: data := aData^;
  3927. 2: data := PWord(aData)^;
  3928. 4: data := PCardinal(aData)^;
  3929. 8: data := PQWord(aData)^;
  3930. else
  3931. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3932. end;
  3933. for i := 0 to 3 do
  3934. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3935. inc(aData, s);
  3936. end;
  3937. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3938. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3939. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3940. procedure TbmpColorTableFormat.CreateColorTable;
  3941. var
  3942. i: Integer;
  3943. begin
  3944. SetLength(fColorTable, 256);
  3945. if (fRange.r = fRange.g) and (fRange.g = fRange.b) and (fRange.r = 0) then begin
  3946. // alpha
  3947. for i := 0 to High(fColorTable) do begin
  3948. fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3949. fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3950. fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3951. fColorTable[i].a := 0;
  3952. end;
  3953. end else begin
  3954. // normal
  3955. for i := 0 to High(fColorTable) do begin
  3956. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3957. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3958. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3959. fColorTable[i].a := 0;
  3960. end;
  3961. end;
  3962. end;
  3963. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3964. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3965. begin
  3966. if (fPixelSize <> 1.0) then
  3967. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3968. if (fRange.r = fRange.g) and (fRange.g = fRange.b) and (fRange.r = 0) then
  3969. // alpha
  3970. aData^ := aPixel.Data.a
  3971. else
  3972. // normal
  3973. aData^ := Round(
  3974. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3975. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3976. ((aPixel.Data.b and Range.b) shl Shift.b));
  3977. inc(aData);
  3978. end;
  3979. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3980. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3981. begin
  3982. if (fPixelSize <> 1.0) then
  3983. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3984. with fColorTable[aData^] do begin
  3985. aPixel.Data.r := r;
  3986. aPixel.Data.g := g;
  3987. aPixel.Data.b := b;
  3988. aPixel.Data.a := a;
  3989. end;
  3990. inc(aData, 1);
  3991. end;
  3992. destructor TbmpColorTableFormat.Destroy;
  3993. begin
  3994. SetLength(fColorTable, 0);
  3995. inherited Destroy;
  3996. end;
  3997. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3998. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3999. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4000. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  4001. var
  4002. i: Integer;
  4003. begin
  4004. for i := 0 to 3 do begin
  4005. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  4006. if (aSourceFD.Range.arr[i] > 0) then
  4007. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  4008. else
  4009. aPixel.Data.arr[i] := 0;
  4010. end;
  4011. end;
  4012. end;
  4013. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4014. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  4015. begin
  4016. with aFuncRec do begin
  4017. if (Source.Range.r > 0) then
  4018. Dest.Data.r := Source.Data.r;
  4019. if (Source.Range.g > 0) then
  4020. Dest.Data.g := Source.Data.g;
  4021. if (Source.Range.b > 0) then
  4022. Dest.Data.b := Source.Data.b;
  4023. if (Source.Range.a > 0) then
  4024. Dest.Data.a := Source.Data.a;
  4025. end;
  4026. end;
  4027. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4028. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  4029. var
  4030. i: Integer;
  4031. begin
  4032. with aFuncRec do begin
  4033. for i := 0 to 3 do
  4034. if (Source.Range.arr[i] > 0) then
  4035. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  4036. end;
  4037. end;
  4038. type
  4039. TShiftData = packed record
  4040. case Integer of
  4041. 0: (r, g, b, a: SmallInt);
  4042. 1: (arr: array[0..3] of SmallInt);
  4043. end;
  4044. PShiftData = ^TShiftData;
  4045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4046. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  4047. var
  4048. i: Integer;
  4049. begin
  4050. with aFuncRec do
  4051. for i := 0 to 3 do
  4052. if (Source.Range.arr[i] > 0) then
  4053. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  4054. end;
  4055. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4056. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  4057. begin
  4058. with aFuncRec do begin
  4059. Dest.Data := Source.Data;
  4060. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  4061. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  4062. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  4063. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  4064. end;
  4065. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  4066. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  4067. end;
  4068. end;
  4069. end;
  4070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4071. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  4072. var
  4073. i: Integer;
  4074. begin
  4075. with aFuncRec do begin
  4076. for i := 0 to 3 do
  4077. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  4078. end;
  4079. end;
  4080. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4081. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  4082. var
  4083. Temp: Single;
  4084. begin
  4085. with FuncRec do begin
  4086. if (FuncRec.Args = nil) then begin //source has no alpha
  4087. Temp :=
  4088. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  4089. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  4090. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  4091. Dest.Data.a := Round(Dest.Range.a * Temp);
  4092. end else
  4093. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  4094. end;
  4095. end;
  4096. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4097. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  4098. type
  4099. PglBitmapPixelData = ^TglBitmapPixelData;
  4100. begin
  4101. with FuncRec do begin
  4102. Dest.Data.r := Source.Data.r;
  4103. Dest.Data.g := Source.Data.g;
  4104. Dest.Data.b := Source.Data.b;
  4105. with PglBitmapPixelData(Args)^ do
  4106. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  4107. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  4108. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  4109. Dest.Data.a := 0
  4110. else
  4111. Dest.Data.a := Dest.Range.a;
  4112. end;
  4113. end;
  4114. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4115. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  4116. begin
  4117. with FuncRec do begin
  4118. Dest.Data.r := Source.Data.r;
  4119. Dest.Data.g := Source.Data.g;
  4120. Dest.Data.b := Source.Data.b;
  4121. Dest.Data.a := PCardinal(Args)^;
  4122. end;
  4123. end;
  4124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4125. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  4126. type
  4127. PRGBPix = ^TRGBPix;
  4128. TRGBPix = array [0..2] of byte;
  4129. var
  4130. Temp: Byte;
  4131. begin
  4132. while aWidth > 0 do begin
  4133. Temp := PRGBPix(aData)^[0];
  4134. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  4135. PRGBPix(aData)^[2] := Temp;
  4136. if aHasAlpha then
  4137. Inc(aData, 4)
  4138. else
  4139. Inc(aData, 3);
  4140. dec(aWidth);
  4141. end;
  4142. end;
  4143. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4144. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4145. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4146. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  4147. begin
  4148. result := TFormatDescriptor.Get(Format);
  4149. end;
  4150. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4151. function TglBitmap.GetWidth: Integer;
  4152. begin
  4153. if (ffX in fDimension.Fields) then
  4154. result := fDimension.X
  4155. else
  4156. result := -1;
  4157. end;
  4158. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4159. function TglBitmap.GetHeight: Integer;
  4160. begin
  4161. if (ffY in fDimension.Fields) then
  4162. result := fDimension.Y
  4163. else
  4164. result := -1;
  4165. end;
  4166. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4167. function TglBitmap.GetFileWidth: Integer;
  4168. begin
  4169. result := Max(1, Width);
  4170. end;
  4171. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4172. function TglBitmap.GetFileHeight: Integer;
  4173. begin
  4174. result := Max(1, Height);
  4175. end;
  4176. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4177. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  4178. begin
  4179. if fCustomData = aValue then
  4180. exit;
  4181. fCustomData := aValue;
  4182. end;
  4183. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4184. procedure TglBitmap.SetCustomName(const aValue: String);
  4185. begin
  4186. if fCustomName = aValue then
  4187. exit;
  4188. fCustomName := aValue;
  4189. end;
  4190. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4191. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  4192. begin
  4193. if fCustomNameW = aValue then
  4194. exit;
  4195. fCustomNameW := aValue;
  4196. end;
  4197. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4198. procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
  4199. begin
  4200. if fFreeDataOnDestroy = aValue then
  4201. exit;
  4202. fFreeDataOnDestroy := aValue;
  4203. end;
  4204. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4205. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  4206. begin
  4207. if fDeleteTextureOnFree = aValue then
  4208. exit;
  4209. fDeleteTextureOnFree := aValue;
  4210. end;
  4211. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4212. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  4213. begin
  4214. if fFormat = aValue then
  4215. exit;
  4216. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  4217. raise EglBitmapUnsupportedFormat.Create(Format);
  4218. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  4219. end;
  4220. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4221. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  4222. begin
  4223. if fFreeDataAfterGenTexture = aValue then
  4224. exit;
  4225. fFreeDataAfterGenTexture := aValue;
  4226. end;
  4227. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4228. procedure TglBitmap.SetID(const aValue: Cardinal);
  4229. begin
  4230. if fID = aValue then
  4231. exit;
  4232. fID := aValue;
  4233. end;
  4234. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4235. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  4236. begin
  4237. if fMipMap = aValue then
  4238. exit;
  4239. fMipMap := aValue;
  4240. end;
  4241. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4242. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  4243. begin
  4244. if fTarget = aValue then
  4245. exit;
  4246. fTarget := aValue;
  4247. end;
  4248. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4249. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  4250. var
  4251. MaxAnisotropic: Integer;
  4252. begin
  4253. fAnisotropic := aValue;
  4254. if (ID > 0) then begin
  4255. if GL_EXT_texture_filter_anisotropic then begin
  4256. if fAnisotropic > 0 then begin
  4257. Bind(false);
  4258. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  4259. if aValue > MaxAnisotropic then
  4260. fAnisotropic := MaxAnisotropic;
  4261. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  4262. end;
  4263. end else begin
  4264. fAnisotropic := 0;
  4265. end;
  4266. end;
  4267. end;
  4268. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4269. procedure TglBitmap.CreateID;
  4270. begin
  4271. if (ID <> 0) then
  4272. glDeleteTextures(1, @fID);
  4273. glGenTextures(1, @fID);
  4274. Bind(false);
  4275. end;
  4276. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4277. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  4278. begin
  4279. // Set Up Parameters
  4280. SetWrap(fWrapS, fWrapT, fWrapR);
  4281. SetFilter(fFilterMin, fFilterMag);
  4282. SetAnisotropic(fAnisotropic);
  4283. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  4284. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4285. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  4286. // Mip Maps Generation Mode
  4287. aBuildWithGlu := false;
  4288. if (MipMap = mmMipmap) then begin
  4289. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  4290. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  4291. else
  4292. aBuildWithGlu := true;
  4293. end else if (MipMap = mmMipmapGlu) then
  4294. aBuildWithGlu := true;
  4295. end;
  4296. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4297. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  4298. const aWidth: Integer; const aHeight: Integer);
  4299. var
  4300. s: Single;
  4301. begin
  4302. if (Data <> aData) then begin
  4303. if (Assigned(Data)) then
  4304. FreeMem(Data);
  4305. fData := aData;
  4306. end;
  4307. if not Assigned(fData) then begin
  4308. fPixelSize := 0;
  4309. fRowSize := 0;
  4310. end else begin
  4311. FillChar(fDimension, SizeOf(fDimension), 0);
  4312. if aWidth <> -1 then begin
  4313. fDimension.Fields := fDimension.Fields + [ffX];
  4314. fDimension.X := aWidth;
  4315. end;
  4316. if aHeight <> -1 then begin
  4317. fDimension.Fields := fDimension.Fields + [ffY];
  4318. fDimension.Y := aHeight;
  4319. end;
  4320. s := TFormatDescriptor.Get(aFormat).PixelSize;
  4321. fFormat := aFormat;
  4322. fPixelSize := Ceil(s);
  4323. fRowSize := Ceil(s * aWidth);
  4324. end;
  4325. end;
  4326. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4327. function TglBitmap.FlipHorz: Boolean;
  4328. begin
  4329. result := false;
  4330. end;
  4331. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4332. function TglBitmap.FlipVert: Boolean;
  4333. begin
  4334. result := false;
  4335. end;
  4336. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4337. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4338. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4339. procedure TglBitmap.AfterConstruction;
  4340. begin
  4341. inherited AfterConstruction;
  4342. fID := 0;
  4343. fTarget := 0;
  4344. fIsResident := false;
  4345. fMipMap := glBitmapDefaultMipmap;
  4346. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  4347. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  4348. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  4349. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  4350. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  4351. end;
  4352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4353. procedure TglBitmap.BeforeDestruction;
  4354. var
  4355. NewData: PByte;
  4356. begin
  4357. if fFreeDataOnDestroy then begin
  4358. NewData := nil;
  4359. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  4360. end;
  4361. if (fID > 0) and fDeleteTextureOnFree then
  4362. glDeleteTextures(1, @fID);
  4363. inherited BeforeDestruction;
  4364. end;
  4365. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4366. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  4367. var
  4368. TempPos: Integer;
  4369. begin
  4370. if not Assigned(aResType) then begin
  4371. TempPos := Pos('.', aResource);
  4372. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  4373. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  4374. end;
  4375. end;
  4376. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4377. procedure TglBitmap.LoadFromFile(const aFilename: String);
  4378. var
  4379. fs: TFileStream;
  4380. begin
  4381. if not FileExists(aFilename) then
  4382. raise EglBitmap.Create('file does not exist: ' + aFilename);
  4383. fFilename := aFilename;
  4384. fs := TFileStream.Create(fFilename, fmOpenRead);
  4385. try
  4386. fs.Position := 0;
  4387. LoadFromStream(fs);
  4388. finally
  4389. fs.Free;
  4390. end;
  4391. end;
  4392. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4393. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  4394. begin
  4395. {$IFDEF GLB_SUPPORT_PNG_READ}
  4396. if not LoadPNG(aStream) then
  4397. {$ENDIF}
  4398. {$IFDEF GLB_SUPPORT_JPEG_READ}
  4399. if not LoadJPEG(aStream) then
  4400. {$ENDIF}
  4401. if not LoadDDS(aStream) then
  4402. if not LoadTGA(aStream) then
  4403. if not LoadBMP(aStream) then
  4404. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  4405. end;
  4406. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4407. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  4408. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  4409. var
  4410. tmpData: PByte;
  4411. size: Integer;
  4412. begin
  4413. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4414. GetMem(tmpData, size);
  4415. try
  4416. FillChar(tmpData^, size, #$FF);
  4417. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4418. except
  4419. if Assigned(tmpData) then
  4420. FreeMem(tmpData);
  4421. raise;
  4422. end;
  4423. AddFunc(Self, aFunc, false, aFormat, aArgs);
  4424. end;
  4425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4426. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  4427. var
  4428. rs: TResourceStream;
  4429. begin
  4430. PrepareResType(aResource, aResType);
  4431. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4432. try
  4433. LoadFromStream(rs);
  4434. finally
  4435. rs.Free;
  4436. end;
  4437. end;
  4438. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4439. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4440. var
  4441. rs: TResourceStream;
  4442. begin
  4443. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4444. try
  4445. LoadFromStream(rs);
  4446. finally
  4447. rs.Free;
  4448. end;
  4449. end;
  4450. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4451. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  4452. var
  4453. fs: TFileStream;
  4454. begin
  4455. fs := TFileStream.Create(aFileName, fmCreate);
  4456. try
  4457. fs.Position := 0;
  4458. SaveToStream(fs, aFileType);
  4459. finally
  4460. fs.Free;
  4461. end;
  4462. end;
  4463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4464. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  4465. begin
  4466. case aFileType of
  4467. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4468. ftPNG: SavePNG(aStream);
  4469. {$ENDIF}
  4470. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  4471. ftJPEG: SaveJPEG(aStream);
  4472. {$ENDIF}
  4473. ftDDS: SaveDDS(aStream);
  4474. ftTGA: SaveTGA(aStream);
  4475. ftBMP: SaveBMP(aStream);
  4476. end;
  4477. end;
  4478. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4479. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  4480. begin
  4481. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  4482. end;
  4483. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4484. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  4485. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  4486. var
  4487. DestData, TmpData, SourceData: pByte;
  4488. TempHeight, TempWidth: Integer;
  4489. SourceFD, DestFD: TFormatDescriptor;
  4490. SourceMD, DestMD: Pointer;
  4491. FuncRec: TglBitmapFunctionRec;
  4492. begin
  4493. Assert(Assigned(Data));
  4494. Assert(Assigned(aSource));
  4495. Assert(Assigned(aSource.Data));
  4496. result := false;
  4497. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  4498. SourceFD := TFormatDescriptor.Get(aSource.Format);
  4499. DestFD := TFormatDescriptor.Get(aFormat);
  4500. if (SourceFD.IsCompressed) then
  4501. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  4502. if (DestFD.IsCompressed) then
  4503. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  4504. // inkompatible Formats so CreateTemp
  4505. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  4506. aCreateTemp := true;
  4507. // Values
  4508. TempHeight := Max(1, aSource.Height);
  4509. TempWidth := Max(1, aSource.Width);
  4510. FuncRec.Sender := Self;
  4511. FuncRec.Args := aArgs;
  4512. TmpData := nil;
  4513. if aCreateTemp then begin
  4514. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  4515. DestData := TmpData;
  4516. end else
  4517. DestData := Data;
  4518. try
  4519. SourceFD.PreparePixel(FuncRec.Source);
  4520. DestFD.PreparePixel (FuncRec.Dest);
  4521. SourceMD := SourceFD.CreateMappingData;
  4522. DestMD := DestFD.CreateMappingData;
  4523. FuncRec.Size := aSource.Dimension;
  4524. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4525. try
  4526. SourceData := aSource.Data;
  4527. FuncRec.Position.Y := 0;
  4528. while FuncRec.Position.Y < TempHeight do begin
  4529. FuncRec.Position.X := 0;
  4530. while FuncRec.Position.X < TempWidth do begin
  4531. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4532. aFunc(FuncRec);
  4533. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  4534. inc(FuncRec.Position.X);
  4535. end;
  4536. inc(FuncRec.Position.Y);
  4537. end;
  4538. // Updating Image or InternalFormat
  4539. if aCreateTemp then
  4540. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  4541. else if (aFormat <> fFormat) then
  4542. Format := aFormat;
  4543. result := true;
  4544. finally
  4545. SourceFD.FreeMappingData(SourceMD);
  4546. DestFD.FreeMappingData(DestMD);
  4547. end;
  4548. except
  4549. if aCreateTemp and Assigned(TmpData) then
  4550. FreeMem(TmpData);
  4551. raise;
  4552. end;
  4553. end;
  4554. end;
  4555. {$IFDEF GLB_SDL}
  4556. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4557. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  4558. var
  4559. Row, RowSize: Integer;
  4560. SourceData, TmpData: PByte;
  4561. TempDepth: Integer;
  4562. FormatDesc: TFormatDescriptor;
  4563. function GetRowPointer(Row: Integer): pByte;
  4564. begin
  4565. result := aSurface.pixels;
  4566. Inc(result, Row * RowSize);
  4567. end;
  4568. begin
  4569. result := false;
  4570. FormatDesc := TFormatDescriptor.Get(Format);
  4571. if FormatDesc.IsCompressed then
  4572. raise EglBitmapUnsupportedFormat.Create(Format);
  4573. if Assigned(Data) then begin
  4574. case Trunc(FormatDesc.PixelSize) of
  4575. 1: TempDepth := 8;
  4576. 2: TempDepth := 16;
  4577. 3: TempDepth := 24;
  4578. 4: TempDepth := 32;
  4579. else
  4580. raise EglBitmapUnsupportedFormat.Create(Format);
  4581. end;
  4582. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4583. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4584. SourceData := Data;
  4585. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4586. for Row := 0 to FileHeight-1 do begin
  4587. TmpData := GetRowPointer(Row);
  4588. if Assigned(TmpData) then begin
  4589. Move(SourceData^, TmpData^, RowSize);
  4590. inc(SourceData, RowSize);
  4591. end;
  4592. end;
  4593. result := true;
  4594. end;
  4595. end;
  4596. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4597. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4598. var
  4599. pSource, pData, pTempData: PByte;
  4600. Row, RowSize, TempWidth, TempHeight: Integer;
  4601. IntFormat: TglBitmapFormat;
  4602. fd: TFormatDescriptor;
  4603. Mask: TglBitmapMask;
  4604. function GetRowPointer(Row: Integer): pByte;
  4605. begin
  4606. result := aSurface^.pixels;
  4607. Inc(result, Row * RowSize);
  4608. end;
  4609. begin
  4610. result := false;
  4611. if (Assigned(aSurface)) then begin
  4612. with aSurface^.format^ do begin
  4613. Mask.r := RMask;
  4614. Mask.g := GMask;
  4615. Mask.b := BMask;
  4616. Mask.a := AMask;
  4617. IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
  4618. if (IntFormat = tfEmpty) then
  4619. raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
  4620. end;
  4621. fd := TFormatDescriptor.Get(IntFormat);
  4622. TempWidth := aSurface^.w;
  4623. TempHeight := aSurface^.h;
  4624. RowSize := fd.GetSize(TempWidth, 1);
  4625. GetMem(pData, TempHeight * RowSize);
  4626. try
  4627. pTempData := pData;
  4628. for Row := 0 to TempHeight -1 do begin
  4629. pSource := GetRowPointer(Row);
  4630. if (Assigned(pSource)) then begin
  4631. Move(pSource^, pTempData^, RowSize);
  4632. Inc(pTempData, RowSize);
  4633. end;
  4634. end;
  4635. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4636. result := true;
  4637. except
  4638. if Assigned(pData) then
  4639. FreeMem(pData);
  4640. raise;
  4641. end;
  4642. end;
  4643. end;
  4644. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4645. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4646. var
  4647. Row, Col, AlphaInterleave: Integer;
  4648. pSource, pDest: PByte;
  4649. function GetRowPointer(Row: Integer): pByte;
  4650. begin
  4651. result := aSurface.pixels;
  4652. Inc(result, Row * Width);
  4653. end;
  4654. begin
  4655. result := false;
  4656. if Assigned(Data) then begin
  4657. if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
  4658. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4659. AlphaInterleave := 0;
  4660. case Format of
  4661. tfLuminance8Alpha8ub2:
  4662. AlphaInterleave := 1;
  4663. tfBGRA8ub4, tfRGBA8ub4:
  4664. AlphaInterleave := 3;
  4665. end;
  4666. pSource := Data;
  4667. for Row := 0 to Height -1 do begin
  4668. pDest := GetRowPointer(Row);
  4669. if Assigned(pDest) then begin
  4670. for Col := 0 to Width -1 do begin
  4671. Inc(pSource, AlphaInterleave);
  4672. pDest^ := pSource^;
  4673. Inc(pDest);
  4674. Inc(pSource);
  4675. end;
  4676. end;
  4677. end;
  4678. result := true;
  4679. end;
  4680. end;
  4681. end;
  4682. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4683. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4684. var
  4685. bmp: TglBitmap2D;
  4686. begin
  4687. bmp := TglBitmap2D.Create;
  4688. try
  4689. bmp.AssignFromSurface(aSurface);
  4690. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4691. finally
  4692. bmp.Free;
  4693. end;
  4694. end;
  4695. {$ENDIF}
  4696. {$IFDEF GLB_DELPHI}
  4697. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4698. function CreateGrayPalette: HPALETTE;
  4699. var
  4700. Idx: Integer;
  4701. Pal: PLogPalette;
  4702. begin
  4703. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4704. Pal.palVersion := $300;
  4705. Pal.palNumEntries := 256;
  4706. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4707. Pal.palPalEntry[Idx].peRed := Idx;
  4708. Pal.palPalEntry[Idx].peGreen := Idx;
  4709. Pal.palPalEntry[Idx].peBlue := Idx;
  4710. Pal.palPalEntry[Idx].peFlags := 0;
  4711. end;
  4712. Result := CreatePalette(Pal^);
  4713. FreeMem(Pal);
  4714. end;
  4715. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4716. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4717. var
  4718. Row: Integer;
  4719. pSource, pData: PByte;
  4720. begin
  4721. result := false;
  4722. if Assigned(Data) then begin
  4723. if Assigned(aBitmap) then begin
  4724. aBitmap.Width := Width;
  4725. aBitmap.Height := Height;
  4726. case Format of
  4727. tfAlpha8ub1, tfLuminance8ub1: begin
  4728. aBitmap.PixelFormat := pf8bit;
  4729. aBitmap.Palette := CreateGrayPalette;
  4730. end;
  4731. tfRGB5A1us1:
  4732. aBitmap.PixelFormat := pf15bit;
  4733. tfR5G6B5us1:
  4734. aBitmap.PixelFormat := pf16bit;
  4735. tfRGB8ub3, tfBGR8ub3:
  4736. aBitmap.PixelFormat := pf24bit;
  4737. tfRGBA8ub4, tfBGRA8ub4:
  4738. aBitmap.PixelFormat := pf32bit;
  4739. else
  4740. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4741. end;
  4742. pSource := Data;
  4743. for Row := 0 to FileHeight -1 do begin
  4744. pData := aBitmap.Scanline[Row];
  4745. Move(pSource^, pData^, fRowSize);
  4746. Inc(pSource, fRowSize);
  4747. if (Format in [tfRGB8ub3, tfRGBA8ub4]) then // swap RGB(A) to BGR(A)
  4748. SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);
  4749. end;
  4750. result := true;
  4751. end;
  4752. end;
  4753. end;
  4754. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4755. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4756. var
  4757. pSource, pData, pTempData: PByte;
  4758. Row, RowSize, TempWidth, TempHeight: Integer;
  4759. IntFormat: TglBitmapFormat;
  4760. begin
  4761. result := false;
  4762. if (Assigned(aBitmap)) then begin
  4763. case aBitmap.PixelFormat of
  4764. pf8bit:
  4765. IntFormat := tfLuminance8ub1;
  4766. pf15bit:
  4767. IntFormat := tfRGB5A1us1;
  4768. pf16bit:
  4769. IntFormat := tfR5G6B5us1;
  4770. pf24bit:
  4771. IntFormat := tfBGR8ub3;
  4772. pf32bit:
  4773. IntFormat := tfBGRA8ub4;
  4774. else
  4775. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4776. end;
  4777. TempWidth := aBitmap.Width;
  4778. TempHeight := aBitmap.Height;
  4779. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4780. GetMem(pData, TempHeight * RowSize);
  4781. try
  4782. pTempData := pData;
  4783. for Row := 0 to TempHeight -1 do begin
  4784. pSource := aBitmap.Scanline[Row];
  4785. if (Assigned(pSource)) then begin
  4786. Move(pSource^, pTempData^, RowSize);
  4787. Inc(pTempData, RowSize);
  4788. end;
  4789. end;
  4790. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4791. result := true;
  4792. except
  4793. if Assigned(pData) then
  4794. FreeMem(pData);
  4795. raise;
  4796. end;
  4797. end;
  4798. end;
  4799. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4800. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4801. var
  4802. Row, Col, AlphaInterleave: Integer;
  4803. pSource, pDest: PByte;
  4804. begin
  4805. result := false;
  4806. if Assigned(Data) then begin
  4807. if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
  4808. if Assigned(aBitmap) then begin
  4809. aBitmap.PixelFormat := pf8bit;
  4810. aBitmap.Palette := CreateGrayPalette;
  4811. aBitmap.Width := Width;
  4812. aBitmap.Height := Height;
  4813. case Format of
  4814. tfLuminance8Alpha8ub2:
  4815. AlphaInterleave := 1;
  4816. tfRGBA8ub4, tfBGRA8ub4:
  4817. AlphaInterleave := 3;
  4818. else
  4819. AlphaInterleave := 0;
  4820. end;
  4821. // Copy Data
  4822. pSource := Data;
  4823. for Row := 0 to Height -1 do begin
  4824. pDest := aBitmap.Scanline[Row];
  4825. if Assigned(pDest) then begin
  4826. for Col := 0 to Width -1 do begin
  4827. Inc(pSource, AlphaInterleave);
  4828. pDest^ := pSource^;
  4829. Inc(pDest);
  4830. Inc(pSource);
  4831. end;
  4832. end;
  4833. end;
  4834. result := true;
  4835. end;
  4836. end;
  4837. end;
  4838. end;
  4839. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4840. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4841. var
  4842. tex: TglBitmap2D;
  4843. begin
  4844. tex := TglBitmap2D.Create;
  4845. try
  4846. tex.AssignFromBitmap(ABitmap);
  4847. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4848. finally
  4849. tex.Free;
  4850. end;
  4851. end;
  4852. {$ENDIF}
  4853. {$IFDEF GLB_LAZARUS}
  4854. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4855. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4856. var
  4857. rid: TRawImageDescription;
  4858. FormatDesc: TFormatDescriptor;
  4859. begin
  4860. if not Assigned(Data) then
  4861. raise EglBitmap.Create('no pixel data assigned. load data before save');
  4862. result := false;
  4863. if not Assigned(aImage) or (Format = tfEmpty) then
  4864. exit;
  4865. FormatDesc := TFormatDescriptor.Get(Format);
  4866. if FormatDesc.IsCompressed then
  4867. exit;
  4868. FillChar(rid{%H-}, SizeOf(rid), 0);
  4869. if FormatDesc.IsGrayscale then
  4870. rid.Format := ricfGray
  4871. else
  4872. rid.Format := ricfRGBA;
  4873. rid.Width := Width;
  4874. rid.Height := Height;
  4875. rid.Depth := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
  4876. rid.BitOrder := riboBitsInOrder;
  4877. rid.ByteOrder := riboLSBFirst;
  4878. rid.LineOrder := riloTopToBottom;
  4879. rid.LineEnd := rileTight;
  4880. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4881. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4882. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4883. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4884. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4885. rid.RedShift := FormatDesc.Shift.r;
  4886. rid.GreenShift := FormatDesc.Shift.g;
  4887. rid.BlueShift := FormatDesc.Shift.b;
  4888. rid.AlphaShift := FormatDesc.Shift.a;
  4889. rid.MaskBitsPerPixel := 0;
  4890. rid.PaletteColorCount := 0;
  4891. aImage.DataDescription := rid;
  4892. aImage.CreateData;
  4893. if not Assigned(aImage.PixelData) then
  4894. raise EglBitmap.Create('error while creating LazIntfImage');
  4895. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4896. result := true;
  4897. end;
  4898. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4899. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4900. var
  4901. f: TglBitmapFormat;
  4902. FormatDesc: TFormatDescriptor;
  4903. ImageData: PByte;
  4904. ImageSize: Integer;
  4905. CanCopy: Boolean;
  4906. Mask: TglBitmapMask;
  4907. procedure CopyConvert;
  4908. var
  4909. bfFormat: TbmpBitfieldFormat;
  4910. pSourceLine, pDestLine: PByte;
  4911. pSourceMD, pDestMD: Pointer;
  4912. x, y: Integer;
  4913. pixel: TglBitmapPixelData;
  4914. begin
  4915. bfFormat := TbmpBitfieldFormat.Create;
  4916. with aImage.DataDescription do begin
  4917. bfFormat.RedMask := ((1 shl RedPrec) - 1) shl RedShift;
  4918. bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
  4919. bfFormat.BlueMask := ((1 shl BluePrec) - 1) shl BlueShift;
  4920. bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
  4921. bfFormat.PixelSize := BitsPerPixel / 8;
  4922. end;
  4923. pSourceMD := bfFormat.CreateMappingData;
  4924. pDestMD := FormatDesc.CreateMappingData;
  4925. try
  4926. for y := 0 to aImage.Height-1 do begin
  4927. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  4928. pDestLine := ImageData + y * Round(FormatDesc.PixelSize * aImage.Width);
  4929. for x := 0 to aImage.Width-1 do begin
  4930. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  4931. FormatDesc.Map(pixel, pDestLine, pDestMD);
  4932. end;
  4933. end;
  4934. finally
  4935. FormatDesc.FreeMappingData(pDestMD);
  4936. bfFormat.FreeMappingData(pSourceMD);
  4937. bfFormat.Free;
  4938. end;
  4939. end;
  4940. begin
  4941. result := false;
  4942. if not Assigned(aImage) then
  4943. exit;
  4944. with aImage.DataDescription do begin
  4945. Mask.r := (QWord(1 shl RedPrec )-1) shl RedShift;
  4946. Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
  4947. Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
  4948. Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
  4949. end;
  4950. FormatDesc := TFormatDescriptor.GetFromMask(Mask);
  4951. f := FormatDesc.Format;
  4952. if (f = tfEmpty) then
  4953. exit;
  4954. CanCopy :=
  4955. (Round(FormatDesc.PixelSize * 8) = aImage.DataDescription.Depth) and
  4956. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  4957. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4958. ImageData := GetMem(ImageSize);
  4959. try
  4960. if CanCopy then
  4961. Move(aImage.PixelData^, ImageData^, ImageSize)
  4962. else
  4963. CopyConvert;
  4964. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4965. except
  4966. if Assigned(ImageData) then
  4967. FreeMem(ImageData);
  4968. raise;
  4969. end;
  4970. result := true;
  4971. end;
  4972. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4973. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4974. var
  4975. rid: TRawImageDescription;
  4976. FormatDesc: TFormatDescriptor;
  4977. Pixel: TglBitmapPixelData;
  4978. x, y: Integer;
  4979. srcMD: Pointer;
  4980. src, dst: PByte;
  4981. begin
  4982. result := false;
  4983. if not Assigned(aImage) or (Format = tfEmpty) then
  4984. exit;
  4985. FormatDesc := TFormatDescriptor.Get(Format);
  4986. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4987. exit;
  4988. FillChar(rid{%H-}, SizeOf(rid), 0);
  4989. rid.Format := ricfGray;
  4990. rid.Width := Width;
  4991. rid.Height := Height;
  4992. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4993. rid.BitOrder := riboBitsInOrder;
  4994. rid.ByteOrder := riboLSBFirst;
  4995. rid.LineOrder := riloTopToBottom;
  4996. rid.LineEnd := rileTight;
  4997. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4998. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4999. rid.GreenPrec := 0;
  5000. rid.BluePrec := 0;
  5001. rid.AlphaPrec := 0;
  5002. rid.RedShift := 0;
  5003. rid.GreenShift := 0;
  5004. rid.BlueShift := 0;
  5005. rid.AlphaShift := 0;
  5006. rid.MaskBitsPerPixel := 0;
  5007. rid.PaletteColorCount := 0;
  5008. aImage.DataDescription := rid;
  5009. aImage.CreateData;
  5010. srcMD := FormatDesc.CreateMappingData;
  5011. try
  5012. FormatDesc.PreparePixel(Pixel);
  5013. src := Data;
  5014. dst := aImage.PixelData;
  5015. for y := 0 to Height-1 do
  5016. for x := 0 to Width-1 do begin
  5017. FormatDesc.Unmap(src, Pixel, srcMD);
  5018. case rid.BitsPerPixel of
  5019. 8: begin
  5020. dst^ := Pixel.Data.a;
  5021. inc(dst);
  5022. end;
  5023. 16: begin
  5024. PWord(dst)^ := Pixel.Data.a;
  5025. inc(dst, 2);
  5026. end;
  5027. 24: begin
  5028. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  5029. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  5030. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  5031. inc(dst, 3);
  5032. end;
  5033. 32: begin
  5034. PCardinal(dst)^ := Pixel.Data.a;
  5035. inc(dst, 4);
  5036. end;
  5037. else
  5038. raise EglBitmapUnsupportedFormat.Create(Format);
  5039. end;
  5040. end;
  5041. finally
  5042. FormatDesc.FreeMappingData(srcMD);
  5043. end;
  5044. result := true;
  5045. end;
  5046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5047. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5048. var
  5049. tex: TglBitmap2D;
  5050. begin
  5051. tex := TglBitmap2D.Create;
  5052. try
  5053. tex.AssignFromLazIntfImage(aImage);
  5054. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  5055. finally
  5056. tex.Free;
  5057. end;
  5058. end;
  5059. {$ENDIF}
  5060. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5061. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  5062. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5063. var
  5064. rs: TResourceStream;
  5065. begin
  5066. PrepareResType(aResource, aResType);
  5067. rs := TResourceStream.Create(aInstance, aResource, aResType);
  5068. try
  5069. result := AddAlphaFromStream(rs, aFunc, aArgs);
  5070. finally
  5071. rs.Free;
  5072. end;
  5073. end;
  5074. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5075. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  5076. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5077. var
  5078. rs: TResourceStream;
  5079. begin
  5080. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  5081. try
  5082. result := AddAlphaFromStream(rs, aFunc, aArgs);
  5083. finally
  5084. rs.Free;
  5085. end;
  5086. end;
  5087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5088. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5089. begin
  5090. if TFormatDescriptor.Get(Format).IsCompressed then
  5091. raise EglBitmapUnsupportedFormat.Create(Format);
  5092. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  5093. end;
  5094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5095. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5096. var
  5097. FS: TFileStream;
  5098. begin
  5099. FS := TFileStream.Create(aFileName, fmOpenRead);
  5100. try
  5101. result := AddAlphaFromStream(FS, aFunc, aArgs);
  5102. finally
  5103. FS.Free;
  5104. end;
  5105. end;
  5106. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5107. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5108. var
  5109. tex: TglBitmap2D;
  5110. begin
  5111. tex := TglBitmap2D.Create(aStream);
  5112. try
  5113. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  5114. finally
  5115. tex.Free;
  5116. end;
  5117. end;
  5118. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5119. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  5120. var
  5121. DestData, DestData2, SourceData: pByte;
  5122. TempHeight, TempWidth: Integer;
  5123. SourceFD, DestFD: TFormatDescriptor;
  5124. SourceMD, DestMD, DestMD2: Pointer;
  5125. FuncRec: TglBitmapFunctionRec;
  5126. begin
  5127. result := false;
  5128. Assert(Assigned(Data));
  5129. Assert(Assigned(aBitmap));
  5130. Assert(Assigned(aBitmap.Data));
  5131. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  5132. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  5133. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  5134. DestFD := TFormatDescriptor.Get(Format);
  5135. if not Assigned(aFunc) then begin
  5136. aFunc := glBitmapAlphaFunc;
  5137. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  5138. end else
  5139. FuncRec.Args := aArgs;
  5140. // Values
  5141. TempHeight := aBitmap.FileHeight;
  5142. TempWidth := aBitmap.FileWidth;
  5143. FuncRec.Sender := Self;
  5144. FuncRec.Size := Dimension;
  5145. FuncRec.Position.Fields := FuncRec.Size.Fields;
  5146. DestData := Data;
  5147. DestData2 := Data;
  5148. SourceData := aBitmap.Data;
  5149. // Mapping
  5150. SourceFD.PreparePixel(FuncRec.Source);
  5151. DestFD.PreparePixel (FuncRec.Dest);
  5152. SourceMD := SourceFD.CreateMappingData;
  5153. DestMD := DestFD.CreateMappingData;
  5154. DestMD2 := DestFD.CreateMappingData;
  5155. try
  5156. FuncRec.Position.Y := 0;
  5157. while FuncRec.Position.Y < TempHeight do begin
  5158. FuncRec.Position.X := 0;
  5159. while FuncRec.Position.X < TempWidth do begin
  5160. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  5161. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  5162. aFunc(FuncRec);
  5163. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  5164. inc(FuncRec.Position.X);
  5165. end;
  5166. inc(FuncRec.Position.Y);
  5167. end;
  5168. finally
  5169. SourceFD.FreeMappingData(SourceMD);
  5170. DestFD.FreeMappingData(DestMD);
  5171. DestFD.FreeMappingData(DestMD2);
  5172. end;
  5173. end;
  5174. end;
  5175. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5176. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  5177. begin
  5178. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  5179. end;
  5180. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5181. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  5182. var
  5183. PixelData: TglBitmapPixelData;
  5184. begin
  5185. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5186. result := AddAlphaFromColorKeyFloat(
  5187. aRed / PixelData.Range.r,
  5188. aGreen / PixelData.Range.g,
  5189. aBlue / PixelData.Range.b,
  5190. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  5191. end;
  5192. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5193. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  5194. var
  5195. values: array[0..2] of Single;
  5196. tmp: Cardinal;
  5197. i: Integer;
  5198. PixelData: TglBitmapPixelData;
  5199. begin
  5200. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5201. with PixelData do begin
  5202. values[0] := aRed;
  5203. values[1] := aGreen;
  5204. values[2] := aBlue;
  5205. for i := 0 to 2 do begin
  5206. tmp := Trunc(Range.arr[i] * aDeviation);
  5207. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  5208. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  5209. end;
  5210. Data.a := 0;
  5211. Range.a := 0;
  5212. end;
  5213. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  5214. end;
  5215. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5216. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  5217. begin
  5218. result := AddAlphaFromValueFloat(aAlpha / $FF);
  5219. end;
  5220. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5221. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  5222. var
  5223. PixelData: TglBitmapPixelData;
  5224. begin
  5225. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5226. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  5227. end;
  5228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5229. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  5230. var
  5231. PixelData: TglBitmapPixelData;
  5232. begin
  5233. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5234. with PixelData do
  5235. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  5236. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  5237. end;
  5238. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5239. function TglBitmap.RemoveAlpha: Boolean;
  5240. var
  5241. FormatDesc: TFormatDescriptor;
  5242. begin
  5243. result := false;
  5244. FormatDesc := TFormatDescriptor.Get(Format);
  5245. if Assigned(Data) then begin
  5246. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  5247. raise EglBitmapUnsupportedFormat.Create(Format);
  5248. result := ConvertTo(FormatDesc.WithoutAlpha);
  5249. end;
  5250. end;
  5251. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5252. function TglBitmap.Clone: TglBitmap;
  5253. var
  5254. Temp: TglBitmap;
  5255. TempPtr: PByte;
  5256. Size: Integer;
  5257. begin
  5258. result := nil;
  5259. Temp := (ClassType.Create as TglBitmap);
  5260. try
  5261. // copy texture data if assigned
  5262. if Assigned(Data) then begin
  5263. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  5264. GetMem(TempPtr, Size);
  5265. try
  5266. Move(Data^, TempPtr^, Size);
  5267. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  5268. except
  5269. if Assigned(TempPtr) then
  5270. FreeMem(TempPtr);
  5271. raise;
  5272. end;
  5273. end else begin
  5274. TempPtr := nil;
  5275. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  5276. end;
  5277. // copy properties
  5278. Temp.fID := ID;
  5279. Temp.fTarget := Target;
  5280. Temp.fFormat := Format;
  5281. Temp.fMipMap := MipMap;
  5282. Temp.fAnisotropic := Anisotropic;
  5283. Temp.fBorderColor := fBorderColor;
  5284. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  5285. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  5286. Temp.fFilterMin := fFilterMin;
  5287. Temp.fFilterMag := fFilterMag;
  5288. Temp.fWrapS := fWrapS;
  5289. Temp.fWrapT := fWrapT;
  5290. Temp.fWrapR := fWrapR;
  5291. Temp.fFilename := fFilename;
  5292. Temp.fCustomName := fCustomName;
  5293. Temp.fCustomNameW := fCustomNameW;
  5294. Temp.fCustomData := fCustomData;
  5295. result := Temp;
  5296. except
  5297. FreeAndNil(Temp);
  5298. raise;
  5299. end;
  5300. end;
  5301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5302. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  5303. var
  5304. SourceFD, DestFD: TFormatDescriptor;
  5305. SourcePD, DestPD: TglBitmapPixelData;
  5306. ShiftData: TShiftData;
  5307. function DataIsIdentical: Boolean;
  5308. begin
  5309. result :=
  5310. (SourceFD.RedMask = DestFD.RedMask) and
  5311. (SourceFD.GreenMask = DestFD.GreenMask) and
  5312. (SourceFD.BlueMask = DestFD.BlueMask) and
  5313. (SourceFD.AlphaMask = DestFD.AlphaMask);
  5314. end;
  5315. function CanCopyDirect: Boolean;
  5316. begin
  5317. result :=
  5318. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5319. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5320. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5321. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5322. end;
  5323. function CanShift: Boolean;
  5324. begin
  5325. result :=
  5326. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5327. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5328. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5329. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5330. end;
  5331. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  5332. begin
  5333. result := 0;
  5334. while (aSource > aDest) and (aSource > 0) do begin
  5335. inc(result);
  5336. aSource := aSource shr 1;
  5337. end;
  5338. end;
  5339. begin
  5340. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  5341. SourceFD := TFormatDescriptor.Get(Format);
  5342. DestFD := TFormatDescriptor.Get(aFormat);
  5343. if DataIsIdentical then begin
  5344. result := true;
  5345. Format := aFormat;
  5346. exit;
  5347. end;
  5348. SourceFD.PreparePixel(SourcePD);
  5349. DestFD.PreparePixel (DestPD);
  5350. if CanCopyDirect then
  5351. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  5352. else if CanShift then begin
  5353. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  5354. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  5355. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  5356. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  5357. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  5358. end else
  5359. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  5360. end else
  5361. result := true;
  5362. end;
  5363. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5364. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  5365. begin
  5366. if aUseRGB or aUseAlpha then
  5367. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  5368. ((Byte(aUseAlpha) and 1) shl 1) or
  5369. (Byte(aUseRGB) and 1) ));
  5370. end;
  5371. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5372. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  5373. begin
  5374. fBorderColor[0] := aRed;
  5375. fBorderColor[1] := aGreen;
  5376. fBorderColor[2] := aBlue;
  5377. fBorderColor[3] := aAlpha;
  5378. if (ID > 0) then begin
  5379. Bind(false);
  5380. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  5381. end;
  5382. end;
  5383. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5384. procedure TglBitmap.FreeData;
  5385. var
  5386. TempPtr: PByte;
  5387. begin
  5388. TempPtr := nil;
  5389. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  5390. end;
  5391. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5392. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  5393. const aAlpha: Byte);
  5394. begin
  5395. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  5396. end;
  5397. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5398. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  5399. var
  5400. PixelData: TglBitmapPixelData;
  5401. begin
  5402. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5403. FillWithColorFloat(
  5404. aRed / PixelData.Range.r,
  5405. aGreen / PixelData.Range.g,
  5406. aBlue / PixelData.Range.b,
  5407. aAlpha / PixelData.Range.a);
  5408. end;
  5409. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5410. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  5411. var
  5412. PixelData: TglBitmapPixelData;
  5413. begin
  5414. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  5415. with PixelData do begin
  5416. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  5417. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  5418. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  5419. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  5420. end;
  5421. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  5422. end;
  5423. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5424. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  5425. begin
  5426. //check MIN filter
  5427. case aMin of
  5428. GL_NEAREST:
  5429. fFilterMin := GL_NEAREST;
  5430. GL_LINEAR:
  5431. fFilterMin := GL_LINEAR;
  5432. GL_NEAREST_MIPMAP_NEAREST:
  5433. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  5434. GL_LINEAR_MIPMAP_NEAREST:
  5435. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  5436. GL_NEAREST_MIPMAP_LINEAR:
  5437. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  5438. GL_LINEAR_MIPMAP_LINEAR:
  5439. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  5440. else
  5441. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  5442. end;
  5443. //check MAG filter
  5444. case aMag of
  5445. GL_NEAREST:
  5446. fFilterMag := GL_NEAREST;
  5447. GL_LINEAR:
  5448. fFilterMag := GL_LINEAR;
  5449. else
  5450. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  5451. end;
  5452. //apply filter
  5453. if (ID > 0) then begin
  5454. Bind(false);
  5455. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  5456. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  5457. case fFilterMin of
  5458. GL_NEAREST, GL_LINEAR:
  5459. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5460. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  5461. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  5462. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  5463. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  5464. end;
  5465. end else
  5466. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5467. end;
  5468. end;
  5469. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5470. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  5471. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  5472. begin
  5473. case aValue of
  5474. GL_CLAMP:
  5475. aTarget := GL_CLAMP;
  5476. GL_REPEAT:
  5477. aTarget := GL_REPEAT;
  5478. GL_CLAMP_TO_EDGE: begin
  5479. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  5480. aTarget := GL_CLAMP_TO_EDGE
  5481. else
  5482. aTarget := GL_CLAMP;
  5483. end;
  5484. GL_CLAMP_TO_BORDER: begin
  5485. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  5486. aTarget := GL_CLAMP_TO_BORDER
  5487. else
  5488. aTarget := GL_CLAMP;
  5489. end;
  5490. GL_MIRRORED_REPEAT: begin
  5491. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  5492. aTarget := GL_MIRRORED_REPEAT
  5493. else
  5494. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  5495. end;
  5496. else
  5497. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  5498. end;
  5499. end;
  5500. begin
  5501. CheckAndSetWrap(S, fWrapS);
  5502. CheckAndSetWrap(T, fWrapT);
  5503. CheckAndSetWrap(R, fWrapR);
  5504. if (ID > 0) then begin
  5505. Bind(false);
  5506. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  5507. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  5508. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  5509. end;
  5510. end;
  5511. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5512. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  5513. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  5514. begin
  5515. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  5516. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  5517. fSwizzle[aIndex] := aValue
  5518. else
  5519. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  5520. end;
  5521. begin
  5522. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  5523. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  5524. CheckAndSetValue(r, 0);
  5525. CheckAndSetValue(g, 1);
  5526. CheckAndSetValue(b, 2);
  5527. CheckAndSetValue(a, 3);
  5528. if (ID > 0) then begin
  5529. Bind(false);
  5530. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  5531. end;
  5532. end;
  5533. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5534. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  5535. begin
  5536. if aEnableTextureUnit then
  5537. glEnable(Target);
  5538. if (ID > 0) then
  5539. glBindTexture(Target, ID);
  5540. end;
  5541. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5542. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  5543. begin
  5544. if aDisableTextureUnit then
  5545. glDisable(Target);
  5546. glBindTexture(Target, 0);
  5547. end;
  5548. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5549. constructor TglBitmap.Create;
  5550. begin
  5551. if (ClassType = TglBitmap) then
  5552. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  5553. {$IFDEF GLB_NATIVE_OGL}
  5554. glbReadOpenGLExtensions;
  5555. {$ENDIF}
  5556. inherited Create;
  5557. fFormat := glBitmapGetDefaultFormat;
  5558. fFreeDataOnDestroy := true;
  5559. end;
  5560. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5561. constructor TglBitmap.Create(const aFileName: String);
  5562. begin
  5563. Create;
  5564. LoadFromFile(aFileName);
  5565. end;
  5566. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5567. constructor TglBitmap.Create(const aStream: TStream);
  5568. begin
  5569. Create;
  5570. LoadFromStream(aStream);
  5571. end;
  5572. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5573. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
  5574. var
  5575. ImageSize: Integer;
  5576. begin
  5577. Create;
  5578. if not Assigned(aData) then begin
  5579. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5580. GetMem(aData, ImageSize);
  5581. try
  5582. FillChar(aData^, ImageSize, #$FF);
  5583. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5584. except
  5585. if Assigned(aData) then
  5586. FreeMem(aData);
  5587. raise;
  5588. end;
  5589. end else begin
  5590. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5591. fFreeDataOnDestroy := false;
  5592. end;
  5593. end;
  5594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5595. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5596. begin
  5597. Create;
  5598. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  5599. end;
  5600. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5601. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  5602. begin
  5603. Create;
  5604. LoadFromResource(aInstance, aResource, aResType);
  5605. end;
  5606. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5607. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5608. begin
  5609. Create;
  5610. LoadFromResourceID(aInstance, aResourceID, aResType);
  5611. end;
  5612. {$IFDEF GLB_SUPPORT_PNG_READ}
  5613. {$IF DEFINED(GLB_LAZ_PNG)}
  5614. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5615. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5616. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5617. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5618. const
  5619. MAGIC_LEN = 8;
  5620. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  5621. var
  5622. reader: TLazReaderPNG;
  5623. intf: TLazIntfImage;
  5624. StreamPos: Int64;
  5625. magic: String[MAGIC_LEN];
  5626. begin
  5627. result := true;
  5628. StreamPos := aStream.Position;
  5629. SetLength(magic, MAGIC_LEN);
  5630. aStream.Read(magic[1], MAGIC_LEN);
  5631. aStream.Position := StreamPos;
  5632. if (magic <> PNG_MAGIC) then begin
  5633. result := false;
  5634. exit;
  5635. end;
  5636. intf := TLazIntfImage.Create(0, 0);
  5637. reader := TLazReaderPNG.Create;
  5638. try try
  5639. reader.UpdateDescription := true;
  5640. reader.ImageRead(aStream, intf);
  5641. AssignFromLazIntfImage(intf);
  5642. except
  5643. result := false;
  5644. aStream.Position := StreamPos;
  5645. exit;
  5646. end;
  5647. finally
  5648. reader.Free;
  5649. intf.Free;
  5650. end;
  5651. end;
  5652. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5653. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5654. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5655. var
  5656. Surface: PSDL_Surface;
  5657. RWops: PSDL_RWops;
  5658. begin
  5659. result := false;
  5660. RWops := glBitmapCreateRWops(aStream);
  5661. try
  5662. if IMG_isPNG(RWops) > 0 then begin
  5663. Surface := IMG_LoadPNG_RW(RWops);
  5664. try
  5665. AssignFromSurface(Surface);
  5666. result := true;
  5667. finally
  5668. SDL_FreeSurface(Surface);
  5669. end;
  5670. end;
  5671. finally
  5672. SDL_FreeRW(RWops);
  5673. end;
  5674. end;
  5675. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5676. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5677. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5678. begin
  5679. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5680. end;
  5681. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5682. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5683. var
  5684. StreamPos: Int64;
  5685. signature: array [0..7] of byte;
  5686. png: png_structp;
  5687. png_info: png_infop;
  5688. TempHeight, TempWidth: Integer;
  5689. Format: TglBitmapFormat;
  5690. png_data: pByte;
  5691. png_rows: array of pByte;
  5692. Row, LineSize: Integer;
  5693. begin
  5694. result := false;
  5695. if not init_libPNG then
  5696. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5697. try
  5698. // signature
  5699. StreamPos := aStream.Position;
  5700. aStream.Read(signature{%H-}, 8);
  5701. aStream.Position := StreamPos;
  5702. if png_check_sig(@signature, 8) <> 0 then begin
  5703. // png read struct
  5704. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5705. if png = nil then
  5706. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5707. // png info
  5708. png_info := png_create_info_struct(png);
  5709. if png_info = nil then begin
  5710. png_destroy_read_struct(@png, nil, nil);
  5711. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5712. end;
  5713. // set read callback
  5714. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5715. // read informations
  5716. png_read_info(png, png_info);
  5717. // size
  5718. TempHeight := png_get_image_height(png, png_info);
  5719. TempWidth := png_get_image_width(png, png_info);
  5720. // format
  5721. case png_get_color_type(png, png_info) of
  5722. PNG_COLOR_TYPE_GRAY:
  5723. Format := tfLuminance8ub1;
  5724. PNG_COLOR_TYPE_GRAY_ALPHA:
  5725. Format := tfLuminance8Alpha8us1;
  5726. PNG_COLOR_TYPE_RGB:
  5727. Format := tfRGB8ub3;
  5728. PNG_COLOR_TYPE_RGB_ALPHA:
  5729. Format := tfRGBA8ub4;
  5730. else
  5731. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5732. end;
  5733. // cut upper 8 bit from 16 bit formats
  5734. if png_get_bit_depth(png, png_info) > 8 then
  5735. png_set_strip_16(png);
  5736. // expand bitdepth smaller than 8
  5737. if png_get_bit_depth(png, png_info) < 8 then
  5738. png_set_expand(png);
  5739. // allocating mem for scanlines
  5740. LineSize := png_get_rowbytes(png, png_info);
  5741. GetMem(png_data, TempHeight * LineSize);
  5742. try
  5743. SetLength(png_rows, TempHeight);
  5744. for Row := Low(png_rows) to High(png_rows) do begin
  5745. png_rows[Row] := png_data;
  5746. Inc(png_rows[Row], Row * LineSize);
  5747. end;
  5748. // read complete image into scanlines
  5749. png_read_image(png, @png_rows[0]);
  5750. // read end
  5751. png_read_end(png, png_info);
  5752. // destroy read struct
  5753. png_destroy_read_struct(@png, @png_info, nil);
  5754. SetLength(png_rows, 0);
  5755. // set new data
  5756. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5757. result := true;
  5758. except
  5759. if Assigned(png_data) then
  5760. FreeMem(png_data);
  5761. raise;
  5762. end;
  5763. end;
  5764. finally
  5765. quit_libPNG;
  5766. end;
  5767. end;
  5768. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5769. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5770. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5771. var
  5772. StreamPos: Int64;
  5773. Png: TPNGObject;
  5774. Header: String[8];
  5775. Row, Col, PixSize, LineSize: Integer;
  5776. NewImage, pSource, pDest, pAlpha: pByte;
  5777. PngFormat: TglBitmapFormat;
  5778. FormatDesc: TFormatDescriptor;
  5779. const
  5780. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5781. begin
  5782. result := false;
  5783. StreamPos := aStream.Position;
  5784. aStream.Read(Header[0], SizeOf(Header));
  5785. aStream.Position := StreamPos;
  5786. {Test if the header matches}
  5787. if Header = PngHeader then begin
  5788. Png := TPNGObject.Create;
  5789. try
  5790. Png.LoadFromStream(aStream);
  5791. case Png.Header.ColorType of
  5792. COLOR_GRAYSCALE:
  5793. PngFormat := tfLuminance8ub1;
  5794. COLOR_GRAYSCALEALPHA:
  5795. PngFormat := tfLuminance8Alpha8us1;
  5796. COLOR_RGB:
  5797. PngFormat := tfBGR8ub3;
  5798. COLOR_RGBALPHA:
  5799. PngFormat := tfBGRA8ub4;
  5800. else
  5801. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5802. end;
  5803. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5804. PixSize := Round(FormatDesc.PixelSize);
  5805. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5806. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5807. try
  5808. pDest := NewImage;
  5809. case Png.Header.ColorType of
  5810. COLOR_RGB, COLOR_GRAYSCALE:
  5811. begin
  5812. for Row := 0 to Png.Height -1 do begin
  5813. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5814. Inc(pDest, LineSize);
  5815. end;
  5816. end;
  5817. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5818. begin
  5819. PixSize := PixSize -1;
  5820. for Row := 0 to Png.Height -1 do begin
  5821. pSource := Png.Scanline[Row];
  5822. pAlpha := pByte(Png.AlphaScanline[Row]);
  5823. for Col := 0 to Png.Width -1 do begin
  5824. Move (pSource^, pDest^, PixSize);
  5825. Inc(pSource, PixSize);
  5826. Inc(pDest, PixSize);
  5827. pDest^ := pAlpha^;
  5828. inc(pAlpha);
  5829. Inc(pDest);
  5830. end;
  5831. end;
  5832. end;
  5833. else
  5834. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5835. end;
  5836. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5837. result := true;
  5838. except
  5839. if Assigned(NewImage) then
  5840. FreeMem(NewImage);
  5841. raise;
  5842. end;
  5843. finally
  5844. Png.Free;
  5845. end;
  5846. end;
  5847. end;
  5848. {$IFEND}
  5849. {$ENDIF}
  5850. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5851. {$IFDEF GLB_LIB_PNG}
  5852. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5853. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5854. begin
  5855. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5856. end;
  5857. {$ENDIF}
  5858. {$IF DEFINED(GLB_LAZ_PNG)}
  5859. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5860. procedure TglBitmap.SavePNG(const aStream: TStream);
  5861. var
  5862. png: TPortableNetworkGraphic;
  5863. intf: TLazIntfImage;
  5864. raw: TRawImage;
  5865. begin
  5866. png := TPortableNetworkGraphic.Create;
  5867. intf := TLazIntfImage.Create(0, 0);
  5868. try
  5869. if not AssignToLazIntfImage(intf) then
  5870. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5871. intf.GetRawImage(raw);
  5872. png.LoadFromRawImage(raw, false);
  5873. png.SaveToStream(aStream);
  5874. finally
  5875. png.Free;
  5876. intf.Free;
  5877. end;
  5878. end;
  5879. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5880. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5881. procedure TglBitmap.SavePNG(const aStream: TStream);
  5882. var
  5883. png: png_structp;
  5884. png_info: png_infop;
  5885. png_rows: array of pByte;
  5886. LineSize: Integer;
  5887. ColorType: Integer;
  5888. Row: Integer;
  5889. FormatDesc: TFormatDescriptor;
  5890. begin
  5891. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5892. raise EglBitmapUnsupportedFormat.Create(Format);
  5893. if not init_libPNG then
  5894. raise Exception.Create('unable to initialize libPNG.');
  5895. try
  5896. case Format of
  5897. tfAlpha8ub1, tfLuminance8ub1:
  5898. ColorType := PNG_COLOR_TYPE_GRAY;
  5899. tfLuminance8Alpha8us1:
  5900. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5901. tfBGR8ub3, tfRGB8ub3:
  5902. ColorType := PNG_COLOR_TYPE_RGB;
  5903. tfBGRA8ub4, tfRGBA8ub4:
  5904. ColorType := PNG_COLOR_TYPE_RGBA;
  5905. else
  5906. raise EglBitmapUnsupportedFormat.Create(Format);
  5907. end;
  5908. FormatDesc := TFormatDescriptor.Get(Format);
  5909. LineSize := FormatDesc.GetSize(Width, 1);
  5910. // creating array for scanline
  5911. SetLength(png_rows, Height);
  5912. try
  5913. for Row := 0 to Height - 1 do begin
  5914. png_rows[Row] := Data;
  5915. Inc(png_rows[Row], Row * LineSize)
  5916. end;
  5917. // write struct
  5918. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5919. if png = nil then
  5920. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5921. // create png info
  5922. png_info := png_create_info_struct(png);
  5923. if png_info = nil then begin
  5924. png_destroy_write_struct(@png, nil);
  5925. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5926. end;
  5927. // set read callback
  5928. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5929. // set compression
  5930. png_set_compression_level(png, 6);
  5931. if Format in [tfBGR8ub3, tfBGRA8ub4] then
  5932. png_set_bgr(png);
  5933. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5934. png_write_info(png, png_info);
  5935. png_write_image(png, @png_rows[0]);
  5936. png_write_end(png, png_info);
  5937. png_destroy_write_struct(@png, @png_info);
  5938. finally
  5939. SetLength(png_rows, 0);
  5940. end;
  5941. finally
  5942. quit_libPNG;
  5943. end;
  5944. end;
  5945. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5946. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5947. procedure TglBitmap.SavePNG(const aStream: TStream);
  5948. var
  5949. Png: TPNGObject;
  5950. pSource, pDest: pByte;
  5951. X, Y, PixSize: Integer;
  5952. ColorType: Cardinal;
  5953. Alpha: Boolean;
  5954. pTemp: pByte;
  5955. Temp: Byte;
  5956. begin
  5957. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5958. raise EglBitmapUnsupportedFormat.Create(Format);
  5959. case Format of
  5960. tfAlpha8ub1, tfLuminance8ub1: begin
  5961. ColorType := COLOR_GRAYSCALE;
  5962. PixSize := 1;
  5963. Alpha := false;
  5964. end;
  5965. tfLuminance8Alpha8us1: begin
  5966. ColorType := COLOR_GRAYSCALEALPHA;
  5967. PixSize := 1;
  5968. Alpha := true;
  5969. end;
  5970. tfBGR8ub3, tfRGB8ub3: begin
  5971. ColorType := COLOR_RGB;
  5972. PixSize := 3;
  5973. Alpha := false;
  5974. end;
  5975. tfBGRA8ub4, tfRGBA8ub4: begin
  5976. ColorType := COLOR_RGBALPHA;
  5977. PixSize := 3;
  5978. Alpha := true
  5979. end;
  5980. else
  5981. raise EglBitmapUnsupportedFormat.Create(Format);
  5982. end;
  5983. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5984. try
  5985. // Copy ImageData
  5986. pSource := Data;
  5987. for Y := 0 to Height -1 do begin
  5988. pDest := png.ScanLine[Y];
  5989. for X := 0 to Width -1 do begin
  5990. Move(pSource^, pDest^, PixSize);
  5991. Inc(pDest, PixSize);
  5992. Inc(pSource, PixSize);
  5993. if Alpha then begin
  5994. png.AlphaScanline[Y]^[X] := pSource^;
  5995. Inc(pSource);
  5996. end;
  5997. end;
  5998. // convert RGB line to BGR
  5999. if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
  6000. pTemp := png.ScanLine[Y];
  6001. for X := 0 to Width -1 do begin
  6002. Temp := pByteArray(pTemp)^[0];
  6003. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  6004. pByteArray(pTemp)^[2] := Temp;
  6005. Inc(pTemp, 3);
  6006. end;
  6007. end;
  6008. end;
  6009. // Save to Stream
  6010. Png.CompressionLevel := 6;
  6011. Png.SaveToStream(aStream);
  6012. finally
  6013. FreeAndNil(Png);
  6014. end;
  6015. end;
  6016. {$IFEND}
  6017. {$ENDIF}
  6018. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6019. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6021. {$IFDEF GLB_LIB_JPEG}
  6022. type
  6023. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  6024. glBitmap_libJPEG_source_mgr = record
  6025. pub: jpeg_source_mgr;
  6026. SrcStream: TStream;
  6027. SrcBuffer: array [1..4096] of byte;
  6028. end;
  6029. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  6030. glBitmap_libJPEG_dest_mgr = record
  6031. pub: jpeg_destination_mgr;
  6032. DestStream: TStream;
  6033. DestBuffer: array [1..4096] of byte;
  6034. end;
  6035. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  6036. begin
  6037. //DUMMY
  6038. end;
  6039. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  6040. begin
  6041. //DUMMY
  6042. end;
  6043. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  6044. begin
  6045. //DUMMY
  6046. end;
  6047. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  6048. begin
  6049. //DUMMY
  6050. end;
  6051. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  6052. begin
  6053. //DUMMY
  6054. end;
  6055. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6056. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  6057. var
  6058. src: glBitmap_libJPEG_source_mgr_ptr;
  6059. bytes: integer;
  6060. begin
  6061. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  6062. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  6063. if (bytes <= 0) then begin
  6064. src^.SrcBuffer[1] := $FF;
  6065. src^.SrcBuffer[2] := JPEG_EOI;
  6066. bytes := 2;
  6067. end;
  6068. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  6069. src^.pub.bytes_in_buffer := bytes;
  6070. result := true;
  6071. end;
  6072. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6073. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  6074. var
  6075. src: glBitmap_libJPEG_source_mgr_ptr;
  6076. begin
  6077. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  6078. if num_bytes > 0 then begin
  6079. // wanted byte isn't in buffer so set stream position and read buffer
  6080. if num_bytes > src^.pub.bytes_in_buffer then begin
  6081. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  6082. src^.pub.fill_input_buffer(cinfo);
  6083. end else begin
  6084. // wanted byte is in buffer so only skip
  6085. inc(src^.pub.next_input_byte, num_bytes);
  6086. dec(src^.pub.bytes_in_buffer, num_bytes);
  6087. end;
  6088. end;
  6089. end;
  6090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6091. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  6092. var
  6093. dest: glBitmap_libJPEG_dest_mgr_ptr;
  6094. begin
  6095. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  6096. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  6097. // write complete buffer
  6098. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  6099. // reset buffer
  6100. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  6101. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  6102. end;
  6103. result := true;
  6104. end;
  6105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6106. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  6107. var
  6108. Idx: Integer;
  6109. dest: glBitmap_libJPEG_dest_mgr_ptr;
  6110. begin
  6111. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  6112. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  6113. // check for endblock
  6114. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  6115. // write endblock
  6116. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  6117. // leave
  6118. break;
  6119. end else
  6120. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  6121. end;
  6122. end;
  6123. {$ENDIF}
  6124. {$IFDEF GLB_SUPPORT_JPEG_READ}
  6125. {$IF DEFINED(GLB_LAZ_JPEG)}
  6126. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6127. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6128. const
  6129. MAGIC_LEN = 2;
  6130. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  6131. var
  6132. intf: TLazIntfImage;
  6133. reader: TFPReaderJPEG;
  6134. StreamPos: Int64;
  6135. magic: String[MAGIC_LEN];
  6136. begin
  6137. result := true;
  6138. StreamPos := aStream.Position;
  6139. SetLength(magic, MAGIC_LEN);
  6140. aStream.Read(magic[1], MAGIC_LEN);
  6141. aStream.Position := StreamPos;
  6142. if (magic <> JPEG_MAGIC) then begin
  6143. result := false;
  6144. exit;
  6145. end;
  6146. reader := TFPReaderJPEG.Create;
  6147. intf := TLazIntfImage.Create(0, 0);
  6148. try try
  6149. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  6150. reader.ImageRead(aStream, intf);
  6151. AssignFromLazIntfImage(intf);
  6152. except
  6153. result := false;
  6154. aStream.Position := StreamPos;
  6155. exit;
  6156. end;
  6157. finally
  6158. reader.Free;
  6159. intf.Free;
  6160. end;
  6161. end;
  6162. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  6163. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6164. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6165. var
  6166. Surface: PSDL_Surface;
  6167. RWops: PSDL_RWops;
  6168. begin
  6169. result := false;
  6170. RWops := glBitmapCreateRWops(aStream);
  6171. try
  6172. if IMG_isJPG(RWops) > 0 then begin
  6173. Surface := IMG_LoadJPG_RW(RWops);
  6174. try
  6175. AssignFromSurface(Surface);
  6176. result := true;
  6177. finally
  6178. SDL_FreeSurface(Surface);
  6179. end;
  6180. end;
  6181. finally
  6182. SDL_FreeRW(RWops);
  6183. end;
  6184. end;
  6185. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  6186. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6187. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6188. var
  6189. StreamPos: Int64;
  6190. Temp: array[0..1]of Byte;
  6191. jpeg: jpeg_decompress_struct;
  6192. jpeg_err: jpeg_error_mgr;
  6193. IntFormat: TglBitmapFormat;
  6194. pImage: pByte;
  6195. TempHeight, TempWidth: Integer;
  6196. pTemp: pByte;
  6197. Row: Integer;
  6198. FormatDesc: TFormatDescriptor;
  6199. begin
  6200. result := false;
  6201. if not init_libJPEG then
  6202. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  6203. try
  6204. // reading first two bytes to test file and set cursor back to begin
  6205. StreamPos := aStream.Position;
  6206. aStream.Read({%H-}Temp[0], 2);
  6207. aStream.Position := StreamPos;
  6208. // if Bitmap then read file.
  6209. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  6210. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  6211. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  6212. // error managment
  6213. jpeg.err := jpeg_std_error(@jpeg_err);
  6214. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  6215. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  6216. // decompression struct
  6217. jpeg_create_decompress(@jpeg);
  6218. // allocation space for streaming methods
  6219. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  6220. // seeting up custom functions
  6221. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  6222. pub.init_source := glBitmap_libJPEG_init_source;
  6223. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  6224. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  6225. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  6226. pub.term_source := glBitmap_libJPEG_term_source;
  6227. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  6228. pub.next_input_byte := nil; // until buffer loaded
  6229. SrcStream := aStream;
  6230. end;
  6231. // set global decoding state
  6232. jpeg.global_state := DSTATE_START;
  6233. // read header of jpeg
  6234. jpeg_read_header(@jpeg, false);
  6235. // setting output parameter
  6236. case jpeg.jpeg_color_space of
  6237. JCS_GRAYSCALE:
  6238. begin
  6239. jpeg.out_color_space := JCS_GRAYSCALE;
  6240. IntFormat := tfLuminance8ub1;
  6241. end;
  6242. else
  6243. jpeg.out_color_space := JCS_RGB;
  6244. IntFormat := tfRGB8ub3;
  6245. end;
  6246. // reading image
  6247. jpeg_start_decompress(@jpeg);
  6248. TempHeight := jpeg.output_height;
  6249. TempWidth := jpeg.output_width;
  6250. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6251. // creating new image
  6252. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  6253. try
  6254. pTemp := pImage;
  6255. for Row := 0 to TempHeight -1 do begin
  6256. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  6257. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  6258. end;
  6259. // finish decompression
  6260. jpeg_finish_decompress(@jpeg);
  6261. // destroy decompression
  6262. jpeg_destroy_decompress(@jpeg);
  6263. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  6264. result := true;
  6265. except
  6266. if Assigned(pImage) then
  6267. FreeMem(pImage);
  6268. raise;
  6269. end;
  6270. end;
  6271. finally
  6272. quit_libJPEG;
  6273. end;
  6274. end;
  6275. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  6276. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6277. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6278. var
  6279. bmp: TBitmap;
  6280. jpg: TJPEGImage;
  6281. StreamPos: Int64;
  6282. Temp: array[0..1]of Byte;
  6283. begin
  6284. result := false;
  6285. // reading first two bytes to test file and set cursor back to begin
  6286. StreamPos := aStream.Position;
  6287. aStream.Read(Temp[0], 2);
  6288. aStream.Position := StreamPos;
  6289. // if Bitmap then read file.
  6290. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  6291. bmp := TBitmap.Create;
  6292. try
  6293. jpg := TJPEGImage.Create;
  6294. try
  6295. jpg.LoadFromStream(aStream);
  6296. bmp.Assign(jpg);
  6297. result := AssignFromBitmap(bmp);
  6298. finally
  6299. jpg.Free;
  6300. end;
  6301. finally
  6302. bmp.Free;
  6303. end;
  6304. end;
  6305. end;
  6306. {$IFEND}
  6307. {$ENDIF}
  6308. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  6309. {$IF DEFINED(GLB_LAZ_JPEG)}
  6310. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6311. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6312. var
  6313. jpeg: TJPEGImage;
  6314. intf: TLazIntfImage;
  6315. raw: TRawImage;
  6316. begin
  6317. jpeg := TJPEGImage.Create;
  6318. intf := TLazIntfImage.Create(0, 0);
  6319. try
  6320. if not AssignToLazIntfImage(intf) then
  6321. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  6322. intf.GetRawImage(raw);
  6323. jpeg.LoadFromRawImage(raw, false);
  6324. jpeg.SaveToStream(aStream);
  6325. finally
  6326. intf.Free;
  6327. jpeg.Free;
  6328. end;
  6329. end;
  6330. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  6331. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6332. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6333. var
  6334. jpeg: jpeg_compress_struct;
  6335. jpeg_err: jpeg_error_mgr;
  6336. Row: Integer;
  6337. pTemp, pTemp2: pByte;
  6338. procedure CopyRow(pDest, pSource: pByte);
  6339. var
  6340. X: Integer;
  6341. begin
  6342. for X := 0 to Width - 1 do begin
  6343. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  6344. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  6345. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  6346. Inc(pDest, 3);
  6347. Inc(pSource, 3);
  6348. end;
  6349. end;
  6350. begin
  6351. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6352. raise EglBitmapUnsupportedFormat.Create(Format);
  6353. if not init_libJPEG then
  6354. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  6355. try
  6356. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  6357. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  6358. // error managment
  6359. jpeg.err := jpeg_std_error(@jpeg_err);
  6360. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  6361. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  6362. // compression struct
  6363. jpeg_create_compress(@jpeg);
  6364. // allocation space for streaming methods
  6365. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  6366. // seeting up custom functions
  6367. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  6368. pub.init_destination := glBitmap_libJPEG_init_destination;
  6369. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  6370. pub.term_destination := glBitmap_libJPEG_term_destination;
  6371. pub.next_output_byte := @DestBuffer[1];
  6372. pub.free_in_buffer := Length(DestBuffer);
  6373. DestStream := aStream;
  6374. end;
  6375. // very important state
  6376. jpeg.global_state := CSTATE_START;
  6377. jpeg.image_width := Width;
  6378. jpeg.image_height := Height;
  6379. case Format of
  6380. tfAlpha8ub1, tfLuminance8ub1: begin
  6381. jpeg.input_components := 1;
  6382. jpeg.in_color_space := JCS_GRAYSCALE;
  6383. end;
  6384. tfRGB8ub3, tfBGR8ub3: begin
  6385. jpeg.input_components := 3;
  6386. jpeg.in_color_space := JCS_RGB;
  6387. end;
  6388. end;
  6389. jpeg_set_defaults(@jpeg);
  6390. jpeg_set_quality(@jpeg, 95, true);
  6391. jpeg_start_compress(@jpeg, true);
  6392. pTemp := Data;
  6393. if Format = tfBGR8ub3 then
  6394. GetMem(pTemp2, fRowSize)
  6395. else
  6396. pTemp2 := pTemp;
  6397. try
  6398. for Row := 0 to jpeg.image_height -1 do begin
  6399. // prepare row
  6400. if Format = tfBGR8ub3 then
  6401. CopyRow(pTemp2, pTemp)
  6402. else
  6403. pTemp2 := pTemp;
  6404. // write row
  6405. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  6406. inc(pTemp, fRowSize);
  6407. end;
  6408. finally
  6409. // free memory
  6410. if Format = tfBGR8ub3 then
  6411. FreeMem(pTemp2);
  6412. end;
  6413. jpeg_finish_compress(@jpeg);
  6414. jpeg_destroy_compress(@jpeg);
  6415. finally
  6416. quit_libJPEG;
  6417. end;
  6418. end;
  6419. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  6420. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6421. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6422. var
  6423. Bmp: TBitmap;
  6424. Jpg: TJPEGImage;
  6425. begin
  6426. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6427. raise EglBitmapUnsupportedFormat.Create(Format);
  6428. Bmp := TBitmap.Create;
  6429. try
  6430. Jpg := TJPEGImage.Create;
  6431. try
  6432. AssignToBitmap(Bmp);
  6433. if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
  6434. Jpg.Grayscale := true;
  6435. Jpg.PixelFormat := jf8Bit;
  6436. end;
  6437. Jpg.Assign(Bmp);
  6438. Jpg.SaveToStream(aStream);
  6439. finally
  6440. FreeAndNil(Jpg);
  6441. end;
  6442. finally
  6443. FreeAndNil(Bmp);
  6444. end;
  6445. end;
  6446. {$IFEND}
  6447. {$ENDIF}
  6448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6449. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6450. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6451. const
  6452. BMP_MAGIC = $4D42;
  6453. BMP_COMP_RGB = 0;
  6454. BMP_COMP_RLE8 = 1;
  6455. BMP_COMP_RLE4 = 2;
  6456. BMP_COMP_BITFIELDS = 3;
  6457. type
  6458. TBMPHeader = packed record
  6459. bfType: Word;
  6460. bfSize: Cardinal;
  6461. bfReserved1: Word;
  6462. bfReserved2: Word;
  6463. bfOffBits: Cardinal;
  6464. end;
  6465. TBMPInfo = packed record
  6466. biSize: Cardinal;
  6467. biWidth: Longint;
  6468. biHeight: Longint;
  6469. biPlanes: Word;
  6470. biBitCount: Word;
  6471. biCompression: Cardinal;
  6472. biSizeImage: Cardinal;
  6473. biXPelsPerMeter: Longint;
  6474. biYPelsPerMeter: Longint;
  6475. biClrUsed: Cardinal;
  6476. biClrImportant: Cardinal;
  6477. end;
  6478. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6479. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  6480. //////////////////////////////////////////////////////////////////////////////////////////////////
  6481. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapMask): TglBitmapFormat;
  6482. begin
  6483. result := tfEmpty;
  6484. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  6485. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  6486. //Read Compression
  6487. case aInfo.biCompression of
  6488. BMP_COMP_RLE4,
  6489. BMP_COMP_RLE8: begin
  6490. raise EglBitmap.Create('RLE compression is not supported');
  6491. end;
  6492. BMP_COMP_BITFIELDS: begin
  6493. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  6494. aStream.Read(aMask.r, SizeOf(aMask.r));
  6495. aStream.Read(aMask.g, SizeOf(aMask.g));
  6496. aStream.Read(aMask.b, SizeOf(aMask.b));
  6497. aStream.Read(aMask.a, SizeOf(aMask.a));
  6498. end else
  6499. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  6500. end;
  6501. end;
  6502. //get suitable format
  6503. case aInfo.biBitCount of
  6504. 8: result := tfLuminance8ub1;
  6505. 16: result := tfX1RGB5us1;
  6506. 24: result := tfBGR8ub3;
  6507. 32: result := tfXRGB8ui1;
  6508. end;
  6509. end;
  6510. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  6511. var
  6512. i, c: Integer;
  6513. ColorTable: TbmpColorTable;
  6514. begin
  6515. result := nil;
  6516. if (aInfo.biBitCount >= 16) then
  6517. exit;
  6518. aFormat := tfLuminance8ub1;
  6519. c := aInfo.biClrUsed;
  6520. if (c = 0) then
  6521. c := 1 shl aInfo.biBitCount;
  6522. SetLength(ColorTable, c);
  6523. for i := 0 to c-1 do begin
  6524. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  6525. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  6526. aFormat := tfRGB8ub3;
  6527. end;
  6528. result := TbmpColorTableFormat.Create;
  6529. result.PixelSize := aInfo.biBitCount / 8;
  6530. result.ColorTable := ColorTable;
  6531. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  6532. end;
  6533. //////////////////////////////////////////////////////////////////////////////////////////////////
  6534. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapMask; const aInfo: TBMPInfo): TbmpBitfieldFormat;
  6535. var
  6536. FormatDesc: TFormatDescriptor;
  6537. begin
  6538. result := nil;
  6539. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  6540. FormatDesc := TFormatDescriptor.GetFromMask(aMask);
  6541. if (FormatDesc.Format = tfEmpty) then
  6542. exit;
  6543. aFormat := FormatDesc.Format;
  6544. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  6545. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  6546. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  6547. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  6548. result := TbmpBitfieldFormat.Create;
  6549. result.PixelSize := aInfo.biBitCount / 8;
  6550. result.RedMask := aMask.r;
  6551. result.GreenMask := aMask.g;
  6552. result.BlueMask := aMask.b;
  6553. result.AlphaMask := aMask.a;
  6554. end;
  6555. end;
  6556. var
  6557. //simple types
  6558. StartPos: Int64;
  6559. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  6560. PaddingBuff: Cardinal;
  6561. LineBuf, ImageData, TmpData: PByte;
  6562. SourceMD, DestMD: Pointer;
  6563. BmpFormat: TglBitmapFormat;
  6564. //records
  6565. Mask: TglBitmapMask;
  6566. Header: TBMPHeader;
  6567. Info: TBMPInfo;
  6568. //classes
  6569. SpecialFormat: TFormatDescriptor;
  6570. FormatDesc: TFormatDescriptor;
  6571. //////////////////////////////////////////////////////////////////////////////////////////////////
  6572. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  6573. var
  6574. i: Integer;
  6575. Pixel: TglBitmapPixelData;
  6576. begin
  6577. aStream.Read(aLineBuf^, rbLineSize);
  6578. SpecialFormat.PreparePixel(Pixel);
  6579. for i := 0 to Info.biWidth-1 do begin
  6580. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  6581. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  6582. FormatDesc.Map(Pixel, aData, DestMD);
  6583. end;
  6584. end;
  6585. begin
  6586. result := false;
  6587. BmpFormat := tfEmpty;
  6588. SpecialFormat := nil;
  6589. LineBuf := nil;
  6590. SourceMD := nil;
  6591. DestMD := nil;
  6592. // Header
  6593. StartPos := aStream.Position;
  6594. aStream.Read(Header{%H-}, SizeOf(Header));
  6595. if Header.bfType = BMP_MAGIC then begin
  6596. try try
  6597. BmpFormat := ReadInfo(Info, Mask);
  6598. SpecialFormat := ReadColorTable(BmpFormat, Info);
  6599. if not Assigned(SpecialFormat) then
  6600. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  6601. aStream.Position := StartPos + Header.bfOffBits;
  6602. if (BmpFormat <> tfEmpty) then begin
  6603. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  6604. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  6605. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  6606. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  6607. //get Memory
  6608. DestMD := FormatDesc.CreateMappingData;
  6609. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  6610. GetMem(ImageData, ImageSize);
  6611. if Assigned(SpecialFormat) then begin
  6612. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  6613. SourceMD := SpecialFormat.CreateMappingData;
  6614. end;
  6615. //read Data
  6616. try try
  6617. FillChar(ImageData^, ImageSize, $FF);
  6618. TmpData := ImageData;
  6619. if (Info.biHeight > 0) then
  6620. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  6621. for i := 0 to Abs(Info.biHeight)-1 do begin
  6622. if Assigned(SpecialFormat) then
  6623. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  6624. else
  6625. aStream.Read(TmpData^, wbLineSize); //else only read data
  6626. if (Info.biHeight > 0) then
  6627. dec(TmpData, wbLineSize)
  6628. else
  6629. inc(TmpData, wbLineSize);
  6630. aStream.Read(PaddingBuff{%H-}, Padding);
  6631. end;
  6632. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6633. result := true;
  6634. finally
  6635. if Assigned(LineBuf) then
  6636. FreeMem(LineBuf);
  6637. if Assigned(SourceMD) then
  6638. SpecialFormat.FreeMappingData(SourceMD);
  6639. FormatDesc.FreeMappingData(DestMD);
  6640. end;
  6641. except
  6642. if Assigned(ImageData) then
  6643. FreeMem(ImageData);
  6644. raise;
  6645. end;
  6646. end else
  6647. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6648. except
  6649. aStream.Position := StartPos;
  6650. raise;
  6651. end;
  6652. finally
  6653. FreeAndNil(SpecialFormat);
  6654. end;
  6655. end
  6656. else aStream.Position := StartPos;
  6657. end;
  6658. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6659. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6660. var
  6661. Header: TBMPHeader;
  6662. Info: TBMPInfo;
  6663. Converter: TFormatDescriptor;
  6664. FormatDesc: TFormatDescriptor;
  6665. SourceFD, DestFD: Pointer;
  6666. pData, srcData, dstData, ConvertBuffer: pByte;
  6667. Pixel: TglBitmapPixelData;
  6668. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6669. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6670. PaddingBuff: Cardinal;
  6671. function GetLineWidth : Integer;
  6672. begin
  6673. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6674. end;
  6675. begin
  6676. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6677. raise EglBitmapUnsupportedFormat.Create(Format);
  6678. Converter := nil;
  6679. FormatDesc := TFormatDescriptor.Get(Format);
  6680. ImageSize := FormatDesc.GetSize(Dimension);
  6681. FillChar(Header{%H-}, SizeOf(Header), 0);
  6682. Header.bfType := BMP_MAGIC;
  6683. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6684. Header.bfReserved1 := 0;
  6685. Header.bfReserved2 := 0;
  6686. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6687. FillChar(Info{%H-}, SizeOf(Info), 0);
  6688. Info.biSize := SizeOf(Info);
  6689. Info.biWidth := Width;
  6690. Info.biHeight := Height;
  6691. Info.biPlanes := 1;
  6692. Info.biCompression := BMP_COMP_RGB;
  6693. Info.biSizeImage := ImageSize;
  6694. try
  6695. case Format of
  6696. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
  6697. begin
  6698. Info.biBitCount := 8;
  6699. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6700. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6701. Converter := TbmpColorTableFormat.Create;
  6702. with (Converter as TbmpColorTableFormat) do begin
  6703. PixelSize := 1;
  6704. Format := fFormat;
  6705. Range := FormatDesc.Range;
  6706. Shift := FormatDesc.Shift;
  6707. CreateColorTable;
  6708. end;
  6709. end;
  6710. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  6711. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  6712. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
  6713. begin
  6714. Info.biBitCount := 16;
  6715. Info.biCompression := BMP_COMP_BITFIELDS;
  6716. end;
  6717. tfBGR8ub3, tfRGB8ub3:
  6718. begin
  6719. Info.biBitCount := 24;
  6720. if (Format = tfRGB8ub3) then
  6721. Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6722. end;
  6723. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  6724. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
  6725. begin
  6726. Info.biBitCount := 32;
  6727. Info.biCompression := BMP_COMP_BITFIELDS;
  6728. end;
  6729. else
  6730. raise EglBitmapUnsupportedFormat.Create(Format);
  6731. end;
  6732. Info.biXPelsPerMeter := 2835;
  6733. Info.biYPelsPerMeter := 2835;
  6734. // prepare bitmasks
  6735. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6736. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6737. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6738. RedMask := FormatDesc.RedMask;
  6739. GreenMask := FormatDesc.GreenMask;
  6740. BlueMask := FormatDesc.BlueMask;
  6741. AlphaMask := FormatDesc.AlphaMask;
  6742. end;
  6743. // headers
  6744. aStream.Write(Header, SizeOf(Header));
  6745. aStream.Write(Info, SizeOf(Info));
  6746. // colortable
  6747. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6748. with (Converter as TbmpColorTableFormat) do
  6749. aStream.Write(ColorTable[0].b,
  6750. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6751. // bitmasks
  6752. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6753. aStream.Write(RedMask, SizeOf(Cardinal));
  6754. aStream.Write(GreenMask, SizeOf(Cardinal));
  6755. aStream.Write(BlueMask, SizeOf(Cardinal));
  6756. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6757. end;
  6758. // image data
  6759. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  6760. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6761. Padding := GetLineWidth - wbLineSize;
  6762. PaddingBuff := 0;
  6763. pData := Data;
  6764. inc(pData, (Height-1) * rbLineSize);
  6765. // prepare row buffer. But only for RGB because RGBA supports color masks
  6766. // so it's possible to change color within the image.
  6767. if Assigned(Converter) then begin
  6768. FormatDesc.PreparePixel(Pixel);
  6769. GetMem(ConvertBuffer, wbLineSize);
  6770. SourceFD := FormatDesc.CreateMappingData;
  6771. DestFD := Converter.CreateMappingData;
  6772. end else
  6773. ConvertBuffer := nil;
  6774. try
  6775. for LineIdx := 0 to Height - 1 do begin
  6776. // preparing row
  6777. if Assigned(Converter) then begin
  6778. srcData := pData;
  6779. dstData := ConvertBuffer;
  6780. for PixelIdx := 0 to Info.biWidth-1 do begin
  6781. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6782. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6783. Converter.Map(Pixel, dstData, DestFD);
  6784. end;
  6785. aStream.Write(ConvertBuffer^, wbLineSize);
  6786. end else begin
  6787. aStream.Write(pData^, rbLineSize);
  6788. end;
  6789. dec(pData, rbLineSize);
  6790. if (Padding > 0) then
  6791. aStream.Write(PaddingBuff, Padding);
  6792. end;
  6793. finally
  6794. // destroy row buffer
  6795. if Assigned(ConvertBuffer) then begin
  6796. FormatDesc.FreeMappingData(SourceFD);
  6797. Converter.FreeMappingData(DestFD);
  6798. FreeMem(ConvertBuffer);
  6799. end;
  6800. end;
  6801. finally
  6802. if Assigned(Converter) then
  6803. Converter.Free;
  6804. end;
  6805. end;
  6806. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6807. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6808. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6809. type
  6810. TTGAHeader = packed record
  6811. ImageID: Byte;
  6812. ColorMapType: Byte;
  6813. ImageType: Byte;
  6814. //ColorMapSpec: Array[0..4] of Byte;
  6815. ColorMapStart: Word;
  6816. ColorMapLength: Word;
  6817. ColorMapEntrySize: Byte;
  6818. OrigX: Word;
  6819. OrigY: Word;
  6820. Width: Word;
  6821. Height: Word;
  6822. Bpp: Byte;
  6823. ImageDesc: Byte;
  6824. end;
  6825. const
  6826. TGA_UNCOMPRESSED_RGB = 2;
  6827. TGA_UNCOMPRESSED_GRAY = 3;
  6828. TGA_COMPRESSED_RGB = 10;
  6829. TGA_COMPRESSED_GRAY = 11;
  6830. TGA_NONE_COLOR_TABLE = 0;
  6831. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6832. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6833. var
  6834. Header: TTGAHeader;
  6835. ImageData: System.PByte;
  6836. StartPosition: Int64;
  6837. PixelSize, LineSize: Integer;
  6838. tgaFormat: TglBitmapFormat;
  6839. FormatDesc: TFormatDescriptor;
  6840. Counter: packed record
  6841. X, Y: packed record
  6842. low, high, dir: Integer;
  6843. end;
  6844. end;
  6845. const
  6846. CACHE_SIZE = $4000;
  6847. ////////////////////////////////////////////////////////////////////////////////////////
  6848. procedure ReadUncompressed;
  6849. var
  6850. i, j: Integer;
  6851. buf, tmp1, tmp2: System.PByte;
  6852. begin
  6853. buf := nil;
  6854. if (Counter.X.dir < 0) then
  6855. GetMem(buf, LineSize);
  6856. try
  6857. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6858. tmp1 := ImageData;
  6859. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6860. if (Counter.X.dir < 0) then begin //flip X
  6861. aStream.Read(buf^, LineSize);
  6862. tmp2 := buf;
  6863. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6864. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6865. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6866. tmp1^ := tmp2^;
  6867. inc(tmp1);
  6868. inc(tmp2);
  6869. end;
  6870. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6871. end;
  6872. end else
  6873. aStream.Read(tmp1^, LineSize);
  6874. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6875. end;
  6876. finally
  6877. if Assigned(buf) then
  6878. FreeMem(buf);
  6879. end;
  6880. end;
  6881. ////////////////////////////////////////////////////////////////////////////////////////
  6882. procedure ReadCompressed;
  6883. /////////////////////////////////////////////////////////////////
  6884. var
  6885. TmpData: System.PByte;
  6886. LinePixelsRead: Integer;
  6887. procedure CheckLine;
  6888. begin
  6889. if (LinePixelsRead >= Header.Width) then begin
  6890. LinePixelsRead := 0;
  6891. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6892. TmpData := ImageData;
  6893. inc(TmpData, Counter.Y.low * LineSize); //set line
  6894. if (Counter.X.dir < 0) then //if x flipped then
  6895. inc(TmpData, LineSize - PixelSize); //set last pixel
  6896. end;
  6897. end;
  6898. /////////////////////////////////////////////////////////////////
  6899. var
  6900. Cache: PByte;
  6901. CacheSize, CachePos: Integer;
  6902. procedure CachedRead(out Buffer; Count: Integer);
  6903. var
  6904. BytesRead: Integer;
  6905. begin
  6906. if (CachePos + Count > CacheSize) then begin
  6907. //if buffer overflow save non read bytes
  6908. BytesRead := 0;
  6909. if (CacheSize - CachePos > 0) then begin
  6910. BytesRead := CacheSize - CachePos;
  6911. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6912. inc(CachePos, BytesRead);
  6913. end;
  6914. //load cache from file
  6915. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6916. aStream.Read(Cache^, CacheSize);
  6917. CachePos := 0;
  6918. //read rest of requested bytes
  6919. if (Count - BytesRead > 0) then begin
  6920. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6921. inc(CachePos, Count - BytesRead);
  6922. end;
  6923. end else begin
  6924. //if no buffer overflow just read the data
  6925. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6926. inc(CachePos, Count);
  6927. end;
  6928. end;
  6929. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6930. begin
  6931. case PixelSize of
  6932. 1: begin
  6933. aBuffer^ := aData^;
  6934. inc(aBuffer, Counter.X.dir);
  6935. end;
  6936. 2: begin
  6937. PWord(aBuffer)^ := PWord(aData)^;
  6938. inc(aBuffer, 2 * Counter.X.dir);
  6939. end;
  6940. 3: begin
  6941. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6942. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6943. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6944. inc(aBuffer, 3 * Counter.X.dir);
  6945. end;
  6946. 4: begin
  6947. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6948. inc(aBuffer, 4 * Counter.X.dir);
  6949. end;
  6950. end;
  6951. end;
  6952. var
  6953. TotalPixelsToRead, TotalPixelsRead: Integer;
  6954. Temp: Byte;
  6955. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6956. PixelRepeat: Boolean;
  6957. PixelsToRead, PixelCount: Integer;
  6958. begin
  6959. CacheSize := 0;
  6960. CachePos := 0;
  6961. TotalPixelsToRead := Header.Width * Header.Height;
  6962. TotalPixelsRead := 0;
  6963. LinePixelsRead := 0;
  6964. GetMem(Cache, CACHE_SIZE);
  6965. try
  6966. TmpData := ImageData;
  6967. inc(TmpData, Counter.Y.low * LineSize); //set line
  6968. if (Counter.X.dir < 0) then //if x flipped then
  6969. inc(TmpData, LineSize - PixelSize); //set last pixel
  6970. repeat
  6971. //read CommandByte
  6972. CachedRead(Temp, 1);
  6973. PixelRepeat := (Temp and $80) > 0;
  6974. PixelsToRead := (Temp and $7F) + 1;
  6975. inc(TotalPixelsRead, PixelsToRead);
  6976. if PixelRepeat then
  6977. CachedRead(buf[0], PixelSize);
  6978. while (PixelsToRead > 0) do begin
  6979. CheckLine;
  6980. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6981. while (PixelCount > 0) do begin
  6982. if not PixelRepeat then
  6983. CachedRead(buf[0], PixelSize);
  6984. PixelToBuffer(@buf[0], TmpData);
  6985. inc(LinePixelsRead);
  6986. dec(PixelsToRead);
  6987. dec(PixelCount);
  6988. end;
  6989. end;
  6990. until (TotalPixelsRead >= TotalPixelsToRead);
  6991. finally
  6992. FreeMem(Cache);
  6993. end;
  6994. end;
  6995. function IsGrayFormat: Boolean;
  6996. begin
  6997. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6998. end;
  6999. begin
  7000. result := false;
  7001. // reading header to test file and set cursor back to begin
  7002. StartPosition := aStream.Position;
  7003. aStream.Read(Header{%H-}, SizeOf(Header));
  7004. // no colormapped files
  7005. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  7006. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  7007. begin
  7008. try
  7009. if Header.ImageID <> 0 then // skip image ID
  7010. aStream.Position := aStream.Position + Header.ImageID;
  7011. tgaFormat := tfEmpty;
  7012. case Header.Bpp of
  7013. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  7014. 0: tgaFormat := tfLuminance8ub1;
  7015. 8: tgaFormat := tfAlpha8ub1;
  7016. end;
  7017. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  7018. 0: tgaFormat := tfLuminance16us1;
  7019. 8: tgaFormat := tfLuminance8Alpha8ub2;
  7020. end else case (Header.ImageDesc and $F) of
  7021. 0: tgaFormat := tfX1RGB5us1;
  7022. 1: tgaFormat := tfA1RGB5us1;
  7023. 4: tgaFormat := tfARGB4us1;
  7024. end;
  7025. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  7026. 0: tgaFormat := tfBGR8ub3;
  7027. end;
  7028. 32: if IsGrayFormat then case (Header.ImageDesc and $F) of
  7029. 0: tgaFormat := tfDepth32ui1;
  7030. end else case (Header.ImageDesc and $F) of
  7031. 0: tgaFormat := tfX2RGB10ui1;
  7032. 2: tgaFormat := tfA2RGB10ui1;
  7033. 8: tgaFormat := tfARGB8ui1;
  7034. end;
  7035. end;
  7036. if (tgaFormat = tfEmpty) then
  7037. raise EglBitmap.Create('LoadTga - unsupported format');
  7038. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  7039. PixelSize := FormatDesc.GetSize(1, 1);
  7040. LineSize := FormatDesc.GetSize(Header.Width, 1);
  7041. GetMem(ImageData, LineSize * Header.Height);
  7042. try
  7043. //column direction
  7044. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  7045. Counter.X.low := Header.Height-1;;
  7046. Counter.X.high := 0;
  7047. Counter.X.dir := -1;
  7048. end else begin
  7049. Counter.X.low := 0;
  7050. Counter.X.high := Header.Height-1;
  7051. Counter.X.dir := 1;
  7052. end;
  7053. // Row direction
  7054. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  7055. Counter.Y.low := 0;
  7056. Counter.Y.high := Header.Height-1;
  7057. Counter.Y.dir := 1;
  7058. end else begin
  7059. Counter.Y.low := Header.Height-1;;
  7060. Counter.Y.high := 0;
  7061. Counter.Y.dir := -1;
  7062. end;
  7063. // Read Image
  7064. case Header.ImageType of
  7065. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  7066. ReadUncompressed;
  7067. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  7068. ReadCompressed;
  7069. end;
  7070. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  7071. result := true;
  7072. except
  7073. if Assigned(ImageData) then
  7074. FreeMem(ImageData);
  7075. raise;
  7076. end;
  7077. finally
  7078. aStream.Position := StartPosition;
  7079. end;
  7080. end
  7081. else aStream.Position := StartPosition;
  7082. end;
  7083. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7084. procedure TglBitmap.SaveTGA(const aStream: TStream);
  7085. var
  7086. Header: TTGAHeader;
  7087. Size: Integer;
  7088. FormatDesc: TFormatDescriptor;
  7089. begin
  7090. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  7091. raise EglBitmapUnsupportedFormat.Create(Format);
  7092. //prepare header
  7093. FormatDesc := TFormatDescriptor.Get(Format);
  7094. FillChar(Header{%H-}, SizeOf(Header), 0);
  7095. Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
  7096. Header.Bpp := Trunc(8 * FormatDesc.PixelSize);
  7097. Header.Width := Width;
  7098. Header.Height := Height;
  7099. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  7100. if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
  7101. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  7102. else
  7103. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  7104. aStream.Write(Header, SizeOf(Header));
  7105. // write Data
  7106. Size := FormatDesc.GetSize(Dimension);
  7107. aStream.Write(Data^, Size);
  7108. end;
  7109. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7110. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7112. const
  7113. DDS_MAGIC: Cardinal = $20534444;
  7114. // DDS_header.dwFlags
  7115. DDSD_CAPS = $00000001;
  7116. DDSD_HEIGHT = $00000002;
  7117. DDSD_WIDTH = $00000004;
  7118. DDSD_PIXELFORMAT = $00001000;
  7119. // DDS_header.sPixelFormat.dwFlags
  7120. DDPF_ALPHAPIXELS = $00000001;
  7121. DDPF_ALPHA = $00000002;
  7122. DDPF_FOURCC = $00000004;
  7123. DDPF_RGB = $00000040;
  7124. DDPF_LUMINANCE = $00020000;
  7125. // DDS_header.sCaps.dwCaps1
  7126. DDSCAPS_TEXTURE = $00001000;
  7127. // DDS_header.sCaps.dwCaps2
  7128. DDSCAPS2_CUBEMAP = $00000200;
  7129. D3DFMT_DXT1 = $31545844;
  7130. D3DFMT_DXT3 = $33545844;
  7131. D3DFMT_DXT5 = $35545844;
  7132. type
  7133. TDDSPixelFormat = packed record
  7134. dwSize: Cardinal;
  7135. dwFlags: Cardinal;
  7136. dwFourCC: Cardinal;
  7137. dwRGBBitCount: Cardinal;
  7138. dwRBitMask: Cardinal;
  7139. dwGBitMask: Cardinal;
  7140. dwBBitMask: Cardinal;
  7141. dwABitMask: Cardinal;
  7142. end;
  7143. TDDSCaps = packed record
  7144. dwCaps1: Cardinal;
  7145. dwCaps2: Cardinal;
  7146. dwDDSX: Cardinal;
  7147. dwReserved: Cardinal;
  7148. end;
  7149. TDDSHeader = packed record
  7150. dwSize: Cardinal;
  7151. dwFlags: Cardinal;
  7152. dwHeight: Cardinal;
  7153. dwWidth: Cardinal;
  7154. dwPitchOrLinearSize: Cardinal;
  7155. dwDepth: Cardinal;
  7156. dwMipMapCount: Cardinal;
  7157. dwReserved: array[0..10] of Cardinal;
  7158. PixelFormat: TDDSPixelFormat;
  7159. Caps: TDDSCaps;
  7160. dwReserved2: Cardinal;
  7161. end;
  7162. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7163. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  7164. var
  7165. Header: TDDSHeader;
  7166. Converter: TbmpBitfieldFormat;
  7167. function GetDDSFormat: TglBitmapFormat;
  7168. var
  7169. fd: TFormatDescriptor;
  7170. i: Integer;
  7171. Mask: TglBitmapMask;
  7172. Range: TglBitmapColorRec;
  7173. match: Boolean;
  7174. begin
  7175. result := tfEmpty;
  7176. with Header.PixelFormat do begin
  7177. // Compresses
  7178. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  7179. case Header.PixelFormat.dwFourCC of
  7180. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  7181. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  7182. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  7183. end;
  7184. end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
  7185. // prepare masks
  7186. if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
  7187. Mask.r := dwRBitMask;
  7188. Mask.g := dwGBitMask;
  7189. Mask.b := dwBBitMask;
  7190. end else begin
  7191. Mask.r := dwRBitMask;
  7192. Mask.g := dwRBitMask;
  7193. Mask.b := dwRBitMask;
  7194. end;
  7195. if (dwFlags and DDPF_ALPHAPIXELS > 0) then
  7196. Mask.a := dwABitMask
  7197. else
  7198. Mask.a := 0;;
  7199. //find matching format
  7200. fd := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
  7201. result := fd.Format;
  7202. if (result <> tfEmpty) then
  7203. exit;
  7204. //find format with same Range
  7205. for i := 0 to 3 do
  7206. Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
  7207. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  7208. fd := TFormatDescriptor.Get(result);
  7209. match := true;
  7210. for i := 0 to 3 do
  7211. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  7212. match := false;
  7213. break;
  7214. end;
  7215. if match then
  7216. break;
  7217. end;
  7218. //no format with same range found -> use default
  7219. if (result = tfEmpty) then begin
  7220. if (dwABitMask > 0) then
  7221. result := tfRGBA8ui1
  7222. else
  7223. result := tfRGB8ub3;
  7224. end;
  7225. Converter := TbmpBitfieldFormat.Create;
  7226. Converter.RedMask := dwRBitMask;
  7227. Converter.GreenMask := dwGBitMask;
  7228. Converter.BlueMask := dwBBitMask;
  7229. Converter.AlphaMask := dwABitMask;
  7230. Converter.PixelSize := dwRGBBitCount / 8;
  7231. end;
  7232. end;
  7233. end;
  7234. var
  7235. StreamPos: Int64;
  7236. x, y, LineSize, RowSize, Magic: Cardinal;
  7237. NewImage, TmpData, RowData, SrcData: System.PByte;
  7238. SourceMD, DestMD: Pointer;
  7239. Pixel: TglBitmapPixelData;
  7240. ddsFormat: TglBitmapFormat;
  7241. FormatDesc: TFormatDescriptor;
  7242. begin
  7243. result := false;
  7244. Converter := nil;
  7245. StreamPos := aStream.Position;
  7246. // Magic
  7247. aStream.Read(Magic{%H-}, sizeof(Magic));
  7248. if (Magic <> DDS_MAGIC) then begin
  7249. aStream.Position := StreamPos;
  7250. exit;
  7251. end;
  7252. //Header
  7253. aStream.Read(Header{%H-}, sizeof(Header));
  7254. if (Header.dwSize <> SizeOf(Header)) or
  7255. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  7256. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  7257. begin
  7258. aStream.Position := StreamPos;
  7259. exit;
  7260. end;
  7261. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  7262. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  7263. ddsFormat := GetDDSFormat;
  7264. try
  7265. if (ddsFormat = tfEmpty) then
  7266. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  7267. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  7268. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  7269. GetMem(NewImage, Header.dwHeight * LineSize);
  7270. try
  7271. TmpData := NewImage;
  7272. //Converter needed
  7273. if Assigned(Converter) then begin
  7274. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  7275. GetMem(RowData, RowSize);
  7276. SourceMD := Converter.CreateMappingData;
  7277. DestMD := FormatDesc.CreateMappingData;
  7278. try
  7279. for y := 0 to Header.dwHeight-1 do begin
  7280. TmpData := NewImage;
  7281. inc(TmpData, y * LineSize);
  7282. SrcData := RowData;
  7283. aStream.Read(SrcData^, RowSize);
  7284. for x := 0 to Header.dwWidth-1 do begin
  7285. Converter.Unmap(SrcData, Pixel, SourceMD);
  7286. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  7287. FormatDesc.Map(Pixel, TmpData, DestMD);
  7288. end;
  7289. end;
  7290. finally
  7291. Converter.FreeMappingData(SourceMD);
  7292. FormatDesc.FreeMappingData(DestMD);
  7293. FreeMem(RowData);
  7294. end;
  7295. end else
  7296. // Compressed
  7297. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  7298. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  7299. for Y := 0 to Header.dwHeight-1 do begin
  7300. aStream.Read(TmpData^, RowSize);
  7301. Inc(TmpData, LineSize);
  7302. end;
  7303. end else
  7304. // Uncompressed
  7305. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  7306. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  7307. for Y := 0 to Header.dwHeight-1 do begin
  7308. aStream.Read(TmpData^, RowSize);
  7309. Inc(TmpData, LineSize);
  7310. end;
  7311. end else
  7312. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  7313. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  7314. result := true;
  7315. except
  7316. if Assigned(NewImage) then
  7317. FreeMem(NewImage);
  7318. raise;
  7319. end;
  7320. finally
  7321. FreeAndNil(Converter);
  7322. end;
  7323. end;
  7324. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7325. procedure TglBitmap.SaveDDS(const aStream: TStream);
  7326. var
  7327. Header: TDDSHeader;
  7328. FormatDesc: TFormatDescriptor;
  7329. begin
  7330. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  7331. raise EglBitmapUnsupportedFormat.Create(Format);
  7332. FormatDesc := TFormatDescriptor.Get(Format);
  7333. // Generell
  7334. FillChar(Header{%H-}, SizeOf(Header), 0);
  7335. Header.dwSize := SizeOf(Header);
  7336. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  7337. Header.dwWidth := Max(1, Width);
  7338. Header.dwHeight := Max(1, Height);
  7339. // Caps
  7340. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  7341. // Pixelformat
  7342. Header.PixelFormat.dwSize := sizeof(Header);
  7343. if (FormatDesc.IsCompressed) then begin
  7344. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  7345. case Format of
  7346. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  7347. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  7348. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  7349. end;
  7350. end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
  7351. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  7352. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  7353. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  7354. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  7355. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  7356. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  7357. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  7358. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  7359. end else begin
  7360. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  7361. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  7362. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  7363. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  7364. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  7365. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  7366. end;
  7367. if (FormatDesc.HasAlpha) then
  7368. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  7369. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  7370. aStream.Write(Header, SizeOf(Header));
  7371. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  7372. end;
  7373. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7374. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7375. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7376. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7377. const aWidth: Integer; const aHeight: Integer);
  7378. var
  7379. pTemp: pByte;
  7380. Size: Integer;
  7381. begin
  7382. if (aHeight > 1) then begin
  7383. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  7384. GetMem(pTemp, Size);
  7385. try
  7386. Move(aData^, pTemp^, Size);
  7387. FreeMem(aData);
  7388. aData := nil;
  7389. except
  7390. FreeMem(pTemp);
  7391. raise;
  7392. end;
  7393. end else
  7394. pTemp := aData;
  7395. inherited SetDataPointer(pTemp, aFormat, aWidth);
  7396. end;
  7397. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7398. function TglBitmap1D.FlipHorz: Boolean;
  7399. var
  7400. Col: Integer;
  7401. pTempDest, pDest, pSource: PByte;
  7402. begin
  7403. result := inherited FlipHorz;
  7404. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  7405. pSource := Data;
  7406. GetMem(pDest, fRowSize);
  7407. try
  7408. pTempDest := pDest;
  7409. Inc(pTempDest, fRowSize);
  7410. for Col := 0 to Width-1 do begin
  7411. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  7412. Move(pSource^, pTempDest^, fPixelSize);
  7413. Inc(pSource, fPixelSize);
  7414. end;
  7415. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  7416. result := true;
  7417. except
  7418. if Assigned(pDest) then
  7419. FreeMem(pDest);
  7420. raise;
  7421. end;
  7422. end;
  7423. end;
  7424. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7425. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  7426. var
  7427. FormatDesc: TFormatDescriptor;
  7428. begin
  7429. // Upload data
  7430. FormatDesc := TFormatDescriptor.Get(Format);
  7431. if FormatDesc.IsCompressed then begin
  7432. if not Assigned(glCompressedTexImage1D) then
  7433. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7434. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  7435. end else if aBuildWithGlu then
  7436. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7437. else
  7438. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7439. // Free Data
  7440. if (FreeDataAfterGenTexture) then
  7441. FreeData;
  7442. end;
  7443. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7444. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  7445. var
  7446. BuildWithGlu, TexRec: Boolean;
  7447. TexSize: Integer;
  7448. begin
  7449. if Assigned(Data) then begin
  7450. // Check Texture Size
  7451. if (aTestTextureSize) then begin
  7452. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7453. if (Width > TexSize) then
  7454. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7455. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7456. (Target = GL_TEXTURE_RECTANGLE);
  7457. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7458. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7459. end;
  7460. CreateId;
  7461. SetupParameters(BuildWithGlu);
  7462. UploadData(BuildWithGlu);
  7463. glAreTexturesResident(1, @fID, @fIsResident);
  7464. end;
  7465. end;
  7466. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7467. procedure TglBitmap1D.AfterConstruction;
  7468. begin
  7469. inherited;
  7470. Target := GL_TEXTURE_1D;
  7471. end;
  7472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7473. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7475. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  7476. begin
  7477. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  7478. result := fLines[aIndex]
  7479. else
  7480. result := nil;
  7481. end;
  7482. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7483. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7484. const aWidth: Integer; const aHeight: Integer);
  7485. var
  7486. Idx, LineWidth: Integer;
  7487. begin
  7488. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  7489. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  7490. // Assigning Data
  7491. if Assigned(Data) then begin
  7492. SetLength(fLines, GetHeight);
  7493. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  7494. for Idx := 0 to GetHeight-1 do begin
  7495. fLines[Idx] := Data;
  7496. Inc(fLines[Idx], Idx * LineWidth);
  7497. end;
  7498. end
  7499. else SetLength(fLines, 0);
  7500. end else begin
  7501. SetLength(fLines, 0);
  7502. end;
  7503. end;
  7504. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7505. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  7506. var
  7507. FormatDesc: TFormatDescriptor;
  7508. begin
  7509. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7510. FormatDesc := TFormatDescriptor.Get(Format);
  7511. if FormatDesc.IsCompressed then begin
  7512. if not Assigned(glCompressedTexImage2D) then
  7513. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7514. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  7515. end else if aBuildWithGlu then begin
  7516. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  7517. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7518. end else begin
  7519. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  7520. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7521. end;
  7522. // Freigeben
  7523. if (FreeDataAfterGenTexture) then
  7524. FreeData;
  7525. end;
  7526. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7527. procedure TglBitmap2D.AfterConstruction;
  7528. begin
  7529. inherited;
  7530. Target := GL_TEXTURE_2D;
  7531. end;
  7532. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7533. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  7534. var
  7535. Temp: pByte;
  7536. Size, w, h: Integer;
  7537. FormatDesc: TFormatDescriptor;
  7538. begin
  7539. FormatDesc := TFormatDescriptor.Get(aFormat);
  7540. if FormatDesc.IsCompressed then
  7541. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7542. w := aRight - aLeft;
  7543. h := aBottom - aTop;
  7544. Size := FormatDesc.GetSize(w, h);
  7545. GetMem(Temp, Size);
  7546. try
  7547. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7548. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7549. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  7550. FlipVert;
  7551. except
  7552. if Assigned(Temp) then
  7553. FreeMem(Temp);
  7554. raise;
  7555. end;
  7556. end;
  7557. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7558. procedure TglBitmap2D.GetDataFromTexture;
  7559. var
  7560. Temp: PByte;
  7561. TempWidth, TempHeight: Integer;
  7562. TempIntFormat: GLint;
  7563. IntFormat: TglBitmapFormat;
  7564. FormatDesc: TFormatDescriptor;
  7565. begin
  7566. Bind;
  7567. // Request Data
  7568. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7569. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7570. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7571. IntFormat := tfEmpty;
  7572. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7573. IntFormat := FormatDesc.Format;
  7574. // Getting data from OpenGL
  7575. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7576. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7577. try
  7578. if FormatDesc.IsCompressed then begin
  7579. if not Assigned(glGetCompressedTexImage) then
  7580. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7581. glGetCompressedTexImage(Target, 0, Temp)
  7582. end else
  7583. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7584. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7585. except
  7586. if Assigned(Temp) then
  7587. FreeMem(Temp);
  7588. raise;
  7589. end;
  7590. end;
  7591. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7592. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7593. var
  7594. BuildWithGlu, PotTex, TexRec: Boolean;
  7595. TexSize: Integer;
  7596. begin
  7597. if Assigned(Data) then begin
  7598. // Check Texture Size
  7599. if (aTestTextureSize) then begin
  7600. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7601. if ((Height > TexSize) or (Width > TexSize)) then
  7602. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7603. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7604. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7605. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7606. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7607. end;
  7608. CreateId;
  7609. SetupParameters(BuildWithGlu);
  7610. UploadData(Target, BuildWithGlu);
  7611. glAreTexturesResident(1, @fID, @fIsResident);
  7612. end;
  7613. end;
  7614. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7615. function TglBitmap2D.FlipHorz: Boolean;
  7616. var
  7617. Col, Row: Integer;
  7618. TempDestData, DestData, SourceData: PByte;
  7619. ImgSize: Integer;
  7620. begin
  7621. result := inherited FlipHorz;
  7622. if Assigned(Data) then begin
  7623. SourceData := Data;
  7624. ImgSize := Height * fRowSize;
  7625. GetMem(DestData, ImgSize);
  7626. try
  7627. TempDestData := DestData;
  7628. Dec(TempDestData, fRowSize + fPixelSize);
  7629. for Row := 0 to Height -1 do begin
  7630. Inc(TempDestData, fRowSize * 2);
  7631. for Col := 0 to Width -1 do begin
  7632. Move(SourceData^, TempDestData^, fPixelSize);
  7633. Inc(SourceData, fPixelSize);
  7634. Dec(TempDestData, fPixelSize);
  7635. end;
  7636. end;
  7637. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7638. result := true;
  7639. except
  7640. if Assigned(DestData) then
  7641. FreeMem(DestData);
  7642. raise;
  7643. end;
  7644. end;
  7645. end;
  7646. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7647. function TglBitmap2D.FlipVert: Boolean;
  7648. var
  7649. Row: Integer;
  7650. TempDestData, DestData, SourceData: PByte;
  7651. begin
  7652. result := inherited FlipVert;
  7653. if Assigned(Data) then begin
  7654. SourceData := Data;
  7655. GetMem(DestData, Height * fRowSize);
  7656. try
  7657. TempDestData := DestData;
  7658. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7659. for Row := 0 to Height -1 do begin
  7660. Move(SourceData^, TempDestData^, fRowSize);
  7661. Dec(TempDestData, fRowSize);
  7662. Inc(SourceData, fRowSize);
  7663. end;
  7664. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7665. result := true;
  7666. except
  7667. if Assigned(DestData) then
  7668. FreeMem(DestData);
  7669. raise;
  7670. end;
  7671. end;
  7672. end;
  7673. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7674. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7675. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7676. type
  7677. TMatrixItem = record
  7678. X, Y: Integer;
  7679. W: Single;
  7680. end;
  7681. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7682. TglBitmapToNormalMapRec = Record
  7683. Scale: Single;
  7684. Heights: array of Single;
  7685. MatrixU : array of TMatrixItem;
  7686. MatrixV : array of TMatrixItem;
  7687. end;
  7688. const
  7689. ONE_OVER_255 = 1 / 255;
  7690. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7691. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7692. var
  7693. Val: Single;
  7694. begin
  7695. with FuncRec do begin
  7696. Val :=
  7697. Source.Data.r * LUMINANCE_WEIGHT_R +
  7698. Source.Data.g * LUMINANCE_WEIGHT_G +
  7699. Source.Data.b * LUMINANCE_WEIGHT_B;
  7700. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7701. end;
  7702. end;
  7703. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7704. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7705. begin
  7706. with FuncRec do
  7707. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7708. end;
  7709. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7710. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7711. type
  7712. TVec = Array[0..2] of Single;
  7713. var
  7714. Idx: Integer;
  7715. du, dv: Double;
  7716. Len: Single;
  7717. Vec: TVec;
  7718. function GetHeight(X, Y: Integer): Single;
  7719. begin
  7720. with FuncRec do begin
  7721. X := Max(0, Min(Size.X -1, X));
  7722. Y := Max(0, Min(Size.Y -1, Y));
  7723. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7724. end;
  7725. end;
  7726. begin
  7727. with FuncRec do begin
  7728. with PglBitmapToNormalMapRec(Args)^ do begin
  7729. du := 0;
  7730. for Idx := Low(MatrixU) to High(MatrixU) do
  7731. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7732. dv := 0;
  7733. for Idx := Low(MatrixU) to High(MatrixU) do
  7734. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7735. Vec[0] := -du * Scale;
  7736. Vec[1] := -dv * Scale;
  7737. Vec[2] := 1;
  7738. end;
  7739. // Normalize
  7740. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7741. if Len <> 0 then begin
  7742. Vec[0] := Vec[0] * Len;
  7743. Vec[1] := Vec[1] * Len;
  7744. Vec[2] := Vec[2] * Len;
  7745. end;
  7746. // Farbe zuweisem
  7747. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7748. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7749. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7750. end;
  7751. end;
  7752. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7753. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7754. var
  7755. Rec: TglBitmapToNormalMapRec;
  7756. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7757. begin
  7758. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7759. Matrix[Index].X := X;
  7760. Matrix[Index].Y := Y;
  7761. Matrix[Index].W := W;
  7762. end;
  7763. end;
  7764. begin
  7765. if TFormatDescriptor.Get(Format).IsCompressed then
  7766. raise EglBitmapUnsupportedFormat.Create(Format);
  7767. if aScale > 100 then
  7768. Rec.Scale := 100
  7769. else if aScale < -100 then
  7770. Rec.Scale := -100
  7771. else
  7772. Rec.Scale := aScale;
  7773. SetLength(Rec.Heights, Width * Height);
  7774. try
  7775. case aFunc of
  7776. nm4Samples: begin
  7777. SetLength(Rec.MatrixU, 2);
  7778. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7779. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7780. SetLength(Rec.MatrixV, 2);
  7781. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7782. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7783. end;
  7784. nmSobel: begin
  7785. SetLength(Rec.MatrixU, 6);
  7786. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7787. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7788. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7789. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7790. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7791. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7792. SetLength(Rec.MatrixV, 6);
  7793. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7794. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7795. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7796. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7797. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7798. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7799. end;
  7800. nm3x3: begin
  7801. SetLength(Rec.MatrixU, 6);
  7802. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7803. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7804. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7805. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7806. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7807. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7808. SetLength(Rec.MatrixV, 6);
  7809. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7810. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7811. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7812. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7813. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7814. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7815. end;
  7816. nm5x5: begin
  7817. SetLength(Rec.MatrixU, 20);
  7818. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7819. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7820. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7821. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7822. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7823. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7824. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7825. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7826. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7827. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7828. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7829. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7830. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7831. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7832. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7833. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7834. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7835. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7836. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7837. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7838. SetLength(Rec.MatrixV, 20);
  7839. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7840. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7841. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7842. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7843. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7844. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7845. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7846. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7847. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7848. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7849. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7850. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7851. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7852. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7853. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7854. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7855. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7856. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7857. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7858. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7859. end;
  7860. end;
  7861. // Daten Sammeln
  7862. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7863. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7864. else
  7865. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7866. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7867. finally
  7868. SetLength(Rec.Heights, 0);
  7869. end;
  7870. end;
  7871. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7872. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7873. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7874. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7875. begin
  7876. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7877. end;
  7878. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7879. procedure TglBitmapCubeMap.AfterConstruction;
  7880. begin
  7881. inherited;
  7882. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7883. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7884. SetWrap;
  7885. Target := GL_TEXTURE_CUBE_MAP;
  7886. fGenMode := GL_REFLECTION_MAP;
  7887. end;
  7888. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7889. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7890. var
  7891. BuildWithGlu: Boolean;
  7892. TexSize: Integer;
  7893. begin
  7894. if (aTestTextureSize) then begin
  7895. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7896. if (Height > TexSize) or (Width > TexSize) then
  7897. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7898. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7899. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7900. end;
  7901. if (ID = 0) then
  7902. CreateID;
  7903. SetupParameters(BuildWithGlu);
  7904. UploadData(aCubeTarget, BuildWithGlu);
  7905. end;
  7906. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7907. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
  7908. begin
  7909. inherited Bind (aEnableTextureUnit);
  7910. if aEnableTexCoordsGen then begin
  7911. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7912. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7913. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7914. glEnable(GL_TEXTURE_GEN_S);
  7915. glEnable(GL_TEXTURE_GEN_T);
  7916. glEnable(GL_TEXTURE_GEN_R);
  7917. end;
  7918. end;
  7919. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7920. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
  7921. begin
  7922. inherited Unbind(aDisableTextureUnit);
  7923. if aDisableTexCoordsGen then begin
  7924. glDisable(GL_TEXTURE_GEN_S);
  7925. glDisable(GL_TEXTURE_GEN_T);
  7926. glDisable(GL_TEXTURE_GEN_R);
  7927. end;
  7928. end;
  7929. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7930. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7931. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7932. type
  7933. TVec = Array[0..2] of Single;
  7934. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7935. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7936. TglBitmapNormalMapRec = record
  7937. HalfSize : Integer;
  7938. Func: TglBitmapNormalMapGetVectorFunc;
  7939. end;
  7940. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7941. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7942. begin
  7943. aVec[0] := aHalfSize;
  7944. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7945. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7946. end;
  7947. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7948. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7949. begin
  7950. aVec[0] := - aHalfSize;
  7951. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7952. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7953. end;
  7954. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7955. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7956. begin
  7957. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7958. aVec[1] := aHalfSize;
  7959. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7960. end;
  7961. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7962. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7963. begin
  7964. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7965. aVec[1] := - aHalfSize;
  7966. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7967. end;
  7968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7969. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7970. begin
  7971. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7972. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7973. aVec[2] := aHalfSize;
  7974. end;
  7975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7976. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7977. begin
  7978. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7979. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7980. aVec[2] := - aHalfSize;
  7981. end;
  7982. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7983. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7984. var
  7985. i: Integer;
  7986. Vec: TVec;
  7987. Len: Single;
  7988. begin
  7989. with FuncRec do begin
  7990. with PglBitmapNormalMapRec(Args)^ do begin
  7991. Func(Vec, Position, HalfSize);
  7992. // Normalize
  7993. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7994. if Len <> 0 then begin
  7995. Vec[0] := Vec[0] * Len;
  7996. Vec[1] := Vec[1] * Len;
  7997. Vec[2] := Vec[2] * Len;
  7998. end;
  7999. // Scale Vector and AddVectro
  8000. Vec[0] := Vec[0] * 0.5 + 0.5;
  8001. Vec[1] := Vec[1] * 0.5 + 0.5;
  8002. Vec[2] := Vec[2] * 0.5 + 0.5;
  8003. end;
  8004. // Set Color
  8005. for i := 0 to 2 do
  8006. Dest.Data.arr[i] := Round(Vec[i] * 255);
  8007. end;
  8008. end;
  8009. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8010. procedure TglBitmapNormalMap.AfterConstruction;
  8011. begin
  8012. inherited;
  8013. fGenMode := GL_NORMAL_MAP;
  8014. end;
  8015. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  8016. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  8017. var
  8018. Rec: TglBitmapNormalMapRec;
  8019. SizeRec: TglBitmapPixelPosition;
  8020. begin
  8021. Rec.HalfSize := aSize div 2;
  8022. FreeDataAfterGenTexture := false;
  8023. SizeRec.Fields := [ffX, ffY];
  8024. SizeRec.X := aSize;
  8025. SizeRec.Y := aSize;
  8026. // Positive X
  8027. Rec.Func := glBitmapNormalMapPosX;
  8028. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8029. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  8030. // Negative X
  8031. Rec.Func := glBitmapNormalMapNegX;
  8032. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8033. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  8034. // Positive Y
  8035. Rec.Func := glBitmapNormalMapPosY;
  8036. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8037. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  8038. // Negative Y
  8039. Rec.Func := glBitmapNormalMapNegY;
  8040. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8041. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  8042. // Positive Z
  8043. Rec.Func := glBitmapNormalMapPosZ;
  8044. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8045. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  8046. // Negative Z
  8047. Rec.Func := glBitmapNormalMapNegZ;
  8048. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);
  8049. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  8050. end;
  8051. initialization
  8052. glBitmapSetDefaultFormat (tfEmpty);
  8053. glBitmapSetDefaultMipmap (mmMipmap);
  8054. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  8055. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  8056. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  8057. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  8058. glBitmapSetDefaultDeleteTextureOnFree (true);
  8059. TFormatDescriptor.Init;
  8060. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  8061. OpenGLInitialized := false;
  8062. InitOpenGLCS := TCriticalSection.Create;
  8063. {$ENDIF}
  8064. finalization
  8065. TFormatDescriptor.Finalize;
  8066. {$IFDEF GLB_NATIVE_OGL}
  8067. if Assigned(GL_LibHandle) then
  8068. glbFreeLibrary(GL_LibHandle);
  8069. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  8070. if Assigned(GLU_LibHandle) then
  8071. glbFreeLibrary(GLU_LibHandle);
  8072. FreeAndNil(InitOpenGLCS);
  8073. {$ENDIF}
  8074. {$ENDIF}
  8075. end.