選択できるのは25トピックまでです。 トピックは、先頭が英数字で、英数字とダッシュ('-')を使用した35文字以内のものにしてください。

9103 行
315 KiB

  1. {***********************************************************
  2. glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  3. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  4. modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
  5. ------------------------------------------------------------
  6. The contents of this file are used with permission, subject to
  7. the Mozilla Public License Version 1.1 (the "License"); you may
  8. not use this file except in compliance with the License. You may
  9. obtain a copy of the License at
  10. http://www.mozilla.org/MPL/MPL-1.1.html
  11. ------------------------------------------------------------
  12. Version 3.0.1
  13. ------------------------------------------------------------
  14. History
  15. 20-11-2013
  16. - refactoring of the complete library
  17. 21-03-2010
  18. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  19. then it's your problem if that isn't true. This prevents the unit for incompatibility
  20. with newer versions of Delphi.
  21. - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  22. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  23. 10-08-2008
  24. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  25. - Additional Datapointer for functioninterface now has the name CustomData
  26. 24-07-2008
  27. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  28. - If you load an texture from an file the property Filename will be set to the name of the file
  29. - Three new properties to attach custom data to the Texture objects
  30. - CustomName (free for use string)
  31. - CustomNameW (free for use widestring)
  32. - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  33. 27-05-2008
  34. - RLE TGAs loaded much faster
  35. 26-05-2008
  36. - fixed some problem with reading RLE TGAs.
  37. 21-05-2008
  38. - function clone now only copys data if it's assigned and now it also copies the ID
  39. - it seems that lazarus dont like comments in comments.
  40. 01-05-2008
  41. - It's possible to set the id of the texture
  42. - define GLB_NO_NATIVE_GL deactivated by default
  43. 27-04-2008
  44. - Now supports the following libraries
  45. - SDL and SDL_image
  46. - libPNG
  47. - libJPEG
  48. - Linux compatibillity via free pascal compatibility (delphi sources optional)
  49. - BMPs now loaded manuel
  50. - Large restructuring
  51. - Property DataPtr now has the name Data
  52. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  53. - Unused Depth removed
  54. - Function FreeData to freeing image data added
  55. 24-10-2007
  56. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  57. 15-11-2006
  58. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  59. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  60. - Function ReadOpenGLExtension is now only intern
  61. 29-06-2006
  62. - pngimage now disabled by default like all other versions.
  63. 26-06-2006
  64. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  65. 22-06-2006
  66. - Fixed some Problem with Delphi 5
  67. - Now uses the newest version of pngimage. Makes saving pngs much easier.
  68. 22-03-2006
  69. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  70. 09-03-2006
  71. - Internal Format ifDepth8 added
  72. - function GrabScreen now supports all uncompressed formats
  73. 31-01-2006
  74. - AddAlphaFromglBitmap implemented
  75. 29-12-2005
  76. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  77. 28-12-2005
  78. - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  79. property Width, Height, Depth are still existing and new property Dimension are avail
  80. 11-12-2005
  81. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  82. 19-10-2005
  83. - Added function GrabScreen to class TglBitmap2D
  84. 18-10-2005
  85. - Added support to Save images
  86. - Added function Clone to Clone Instance
  87. 11-10-2005
  88. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  89. Usefull for Future
  90. - Several speed optimizations
  91. 09-10-2005
  92. - Internal structure change. Loading of TGA, PNG and DDS improved.
  93. Data, format and size will now set directly with SetDataPtr.
  94. - AddFunc now works with all Types of Images and Formats
  95. - Some Funtions moved to Baseclass TglBitmap
  96. 06-10-2005
  97. - Added Support to decompress DXT3 and DXT5 compressed Images.
  98. - Added Mapping to convert data from one format into an other.
  99. 05-10-2005
  100. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  101. supported Input format (supported by GetPixel) into any uncompresed Format
  102. - Added Support to decompress DXT1 compressed Images.
  103. - SwapColors replaced by ConvertTo
  104. 04-10-2005
  105. - Added Support for compressed DDSs
  106. - Added new internal formats (DXT1, DXT3, DXT5)
  107. 29-09-2005
  108. - Parameter Components renamed to InternalFormat
  109. 23-09-2005
  110. - Some AllocMem replaced with GetMem (little speed change)
  111. - better exception handling. Better protection from memory leaks.
  112. 22-09-2005
  113. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
  114. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
  115. 07-09-2005
  116. - Added support for Grayscale textures
  117. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
  118. 10-07-2005
  119. - Added support for GL_VERSION_2_0
  120. - Added support for GL_EXT_texture_filter_anisotropic
  121. 04-07-2005
  122. - Function FillWithColor fills the Image with one Color
  123. - Function LoadNormalMap added
  124. 30-06-2005
  125. - ToNormalMap allows to Create an NormalMap from the Alphachannel
  126. - ToNormalMap now supports Sobel (nmSobel) function.
  127. 29-06-2005
  128. - support for RLE Compressed RGB TGAs added
  129. 28-06-2005
  130. - Class TglBitmapNormalMap added to support Normalmap generation
  131. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
  132. 3 Filters are supported. (4 Samples, 3x3 and 5x5)
  133. 16-06-2005
  134. - Method LoadCubeMapClass removed
  135. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
  136. - virtual abstract method GenTexture in class TglBitmap now is protected
  137. 12-06-2005
  138. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
  139. 10-06-2005
  140. - little enhancement for IsPowerOfTwo
  141. - TglBitmap1D.GenTexture now tests NPOT Textures
  142. 06-06-2005
  143. - some little name changes. All properties or function with Texture in name are
  144. now without texture in name. We have allways texture so we dosn't name it.
  145. 03-06-2005
  146. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
  147. TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
  148. 02-06-2005
  149. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
  150. 25-04-2005
  151. - Function Unbind added
  152. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
  153. 21-04-2005
  154. - class TglBitmapCubeMap added (allows to Create Cubemaps)
  155. 29-03-2005
  156. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
  157. To Enable png's use the define pngimage
  158. 22-03-2005
  159. - New Functioninterface added
  160. - Function GetPixel added
  161. 27-11-2004
  162. - Property BuildMipMaps renamed to MipMap
  163. 21-11-2004
  164. - property Name removed.
  165. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
  166. 22-05-2004
  167. - property name added. Only used in glForms!
  168. 26-11-2003
  169. - property FreeDataAfterGenTexture is now available as default (default = true)
  170. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
  171. - function MoveMemory replaced with function Move (little speed change)
  172. - several calculations stored in variables (little speed change)
  173. 29-09-2003
  174. - property BuildMipsMaps added (default = true)
  175. if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
  176. - property FreeDataAfterGenTexture added (default = true)
  177. if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
  178. - parameter DisableOtherTextureUnits of Bind removed
  179. - parameter FreeDataAfterGeneration of GenTextures removed
  180. 12-09-2003
  181. - TglBitmap dosn't delete data if class was destroyed (fixed)
  182. 09-09-2003
  183. - Bind now enables TextureUnits (by params)
  184. - GenTextures can leave data (by param)
  185. - LoadTextures now optimal
  186. 03-09-2003
  187. - Performance optimization in AddFunc
  188. - procedure Bind moved to subclasses
  189. - Added new Class TglBitmap1D to support real OpenGL 1D Textures
  190. 19-08-2003
  191. - Texturefilter and texturewrap now also as defaults
  192. Minfilter = GL_LINEAR_MIPMAP_LINEAR
  193. Magfilter = GL_LINEAR
  194. Wrap(str) = GL_CLAMP_TO_EDGE
  195. - Added new format tfCompressed to create a compressed texture.
  196. - propertys IsCompressed, TextureSize and IsResident added
  197. IsCompressed and TextureSize only contains data from level 0
  198. 18-08-2003
  199. - Added function AddFunc to add PerPixelEffects to Image
  200. - LoadFromFunc now based on AddFunc
  201. - Invert now based on AddFunc
  202. - SwapColors now based on AddFunc
  203. 16-08-2003
  204. - Added function FlipHorz
  205. 15-08-2003
  206. - Added function LaodFromFunc to create images with function
  207. - Added function FlipVert
  208. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
  209. 29-07-2003
  210. - Added Alphafunctions to calculate alpha per function
  211. - Added Alpha from ColorKey using alphafunctions
  212. 28-07-2003
  213. - First full functionally Version of glBitmap
  214. - Support for 24Bit and 32Bit TGA Pictures added
  215. 25-07-2003
  216. - begin of programming
  217. ***********************************************************}
  218. unit uglcBitmap;
  219. // Please uncomment the defines below to configure the glBitmap to your preferences.
  220. // If you have configured the unit you can uncomment the warning above.
  221. {.$MESSAGE error 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  223. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  225. // 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. TglBitmapFormat = (
  662. tfEmpty = 0, //must be smallest value!
  663. tfAlpha4,
  664. tfAlpha8,
  665. tfAlpha16,
  666. tfLuminance4,
  667. tfLuminance8,
  668. tfLuminance16,
  669. tfLuminance4Alpha4,
  670. tfLuminance6Alpha2,
  671. tfLuminance8Alpha8,
  672. tfLuminance12Alpha4,
  673. tfLuminance16Alpha16,
  674. tfR3G3B2,
  675. tfRGBX4,
  676. tfXRGB4,
  677. tfR5G6B5,
  678. tfRGB5X1,
  679. tfX1RGB5,
  680. tfRGB8,
  681. tfRGBX8,
  682. tfXRGB8,
  683. tfRGB10X2,
  684. tfX2RGB10,
  685. tfRGB16,
  686. tfRGBA4,
  687. tfARGB4,
  688. tfRGB5A1,
  689. tfA1RGB5,
  690. tfRGBA8,
  691. tfARGB8,
  692. tfRGB10A2,
  693. tfA2RGB10,
  694. tfRGBA16,
  695. tfBGRX4,
  696. tfXBGR4,
  697. tfB5G6R5,
  698. tfBGR5X1,
  699. tfX1BGR5,
  700. tfBGR8,
  701. tfBGRX8,
  702. tfXBGR8,
  703. tfBGR10X2,
  704. tfX2BGR10,
  705. tfBGR16,
  706. tfBGRA4,
  707. tfABGR4,
  708. tfBGR5A1,
  709. tfA1BGR5,
  710. tfBGRA8,
  711. tfABGR8,
  712. tfBGR10A2,
  713. tfA2BGR10,
  714. tfBGRA16,
  715. tfDepth16,
  716. tfDepth24,
  717. tfDepth32,
  718. tfS3tcDtx1RGBA,
  719. tfS3tcDtx3RGBA,
  720. tfS3tcDtx5RGBA
  721. );
  722. TglBitmapFileType = (
  723. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  724. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  725. ftDDS,
  726. ftTGA,
  727. ftBMP);
  728. TglBitmapFileTypes = set of TglBitmapFileType;
  729. TglBitmapMipMap = (
  730. mmNone,
  731. mmMipmap,
  732. mmMipmapGlu);
  733. TglBitmapNormalMapFunc = (
  734. nm4Samples,
  735. nmSobel,
  736. nm3x3,
  737. nm5x5);
  738. ////////////////////////////////////////////////////////////////////////////////////////////////////
  739. EglBitmap = class(Exception);
  740. EglBitmapNotSupported = class(Exception);
  741. EglBitmapSizeToLarge = class(EglBitmap);
  742. EglBitmapNonPowerOfTwo = class(EglBitmap);
  743. EglBitmapUnsupportedFormat = class(EglBitmap)
  744. public
  745. constructor Create(const aFormat: TglBitmapFormat); overload;
  746. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  747. end;
  748. ////////////////////////////////////////////////////////////////////////////////////////////////////
  749. TglBitmapColorRec = packed record
  750. case Integer of
  751. 0: (r, g, b, a: Cardinal);
  752. 1: (arr: array[0..3] of Cardinal);
  753. end;
  754. TglBitmapPixelData = packed record
  755. Data, Range: TglBitmapColorRec;
  756. Format: TglBitmapFormat;
  757. end;
  758. PglBitmapPixelData = ^TglBitmapPixelData;
  759. ////////////////////////////////////////////////////////////////////////////////////////////////////
  760. TglBitmapPixelPositionFields = set of (ffX, ffY);
  761. TglBitmapPixelPosition = record
  762. Fields : TglBitmapPixelPositionFields;
  763. X : Word;
  764. Y : Word;
  765. end;
  766. TglBitmapFormatDescriptor = class(TObject)
  767. protected
  768. function GetIsCompressed: Boolean; virtual; abstract;
  769. function GetHasRed: Boolean; virtual; abstract;
  770. function GetHasGreen: Boolean; virtual; abstract;
  771. function GetHasBlue: Boolean; virtual; abstract;
  772. function GetHasAlpha: Boolean; virtual; abstract;
  773. function GetRGBInverted: TglBitmapFormat; virtual; abstract;
  774. function GetWithAlpha: TglBitmapFormat; virtual; abstract;
  775. function GetWithoutAlpha: TglBitmapFormat; virtual; abstract;
  776. function GetOpenGLFormat: TglBitmapFormat; virtual; abstract;
  777. function GetUncompressed: TglBitmapFormat; virtual; abstract;
  778. function GetglDataFormat: GLenum; virtual; abstract;
  779. function GetglFormat: GLenum; virtual; abstract;
  780. function GetglInternalFormat: GLenum; virtual; abstract;
  781. public
  782. property IsCompressed: Boolean read GetIsCompressed;
  783. property HasRed: Boolean read GetHasRed;
  784. property HasGreen: Boolean read GetHasGreen;
  785. property HasBlue: Boolean read GetHasBlue;
  786. property HasAlpha: Boolean read GetHasAlpha;
  787. property RGBInverted: TglBitmapFormat read GetRGBInverted;
  788. property WithAlpha: TglBitmapFormat read GetWithAlpha;
  789. property WithoutAlpha: TglBitmapFormat read GetWithoutAlpha;
  790. property OpenGLFormat: TglBitmapFormat read GetOpenGLFormat;
  791. property Uncompressed: TglBitmapFormat read GetUncompressed;
  792. property glFormat: GLenum read GetglFormat;
  793. property glInternalFormat: GLenum read GetglInternalFormat;
  794. property glDataFormat: GLenum read GetglDataFormat;
  795. public
  796. class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  797. end;
  798. ////////////////////////////////////////////////////////////////////////////////////////////////////
  799. TglBitmap = class;
  800. TglBitmapFunctionRec = record
  801. Sender: TglBitmap;
  802. Size: TglBitmapPixelPosition;
  803. Position: TglBitmapPixelPosition;
  804. Source: TglBitmapPixelData;
  805. Dest: TglBitmapPixelData;
  806. Args: Pointer;
  807. end;
  808. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  809. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  810. TglBitmap = class
  811. private
  812. function GetFormatDesc: TglBitmapFormatDescriptor;
  813. protected
  814. fID: GLuint;
  815. fTarget: GLuint;
  816. fAnisotropic: Integer;
  817. fDeleteTextureOnFree: Boolean;
  818. fFreeDataOnDestroy: Boolean;
  819. fFreeDataAfterGenTexture: Boolean;
  820. fData: PByte;
  821. fIsResident: GLboolean;
  822. fBorderColor: array[0..3] of Single;
  823. fDimension: TglBitmapPixelPosition;
  824. fMipMap: TglBitmapMipMap;
  825. fFormat: TglBitmapFormat;
  826. // Mapping
  827. fPixelSize: Integer;
  828. fRowSize: Integer;
  829. // Filtering
  830. fFilterMin: GLenum;
  831. fFilterMag: GLenum;
  832. // TexturWarp
  833. fWrapS: GLenum;
  834. fWrapT: GLenum;
  835. fWrapR: GLenum;
  836. //Swizzle
  837. fSwizzle: array[0..3] of GLenum;
  838. // CustomData
  839. fFilename: String;
  840. fCustomName: String;
  841. fCustomNameW: WideString;
  842. fCustomData: Pointer;
  843. //Getter
  844. function GetWidth: Integer; virtual;
  845. function GetHeight: Integer; virtual;
  846. function GetFileWidth: Integer; virtual;
  847. function GetFileHeight: Integer; virtual;
  848. //Setter
  849. procedure SetCustomData(const aValue: Pointer);
  850. procedure SetCustomName(const aValue: String);
  851. procedure SetCustomNameW(const aValue: WideString);
  852. procedure SetFreeDataOnDestroy(const aValue: Boolean);
  853. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  854. procedure SetFormat(const aValue: TglBitmapFormat);
  855. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  856. procedure SetID(const aValue: Cardinal);
  857. procedure SetMipMap(const aValue: TglBitmapMipMap);
  858. procedure SetTarget(const aValue: Cardinal);
  859. procedure SetAnisotropic(const aValue: Integer);
  860. procedure CreateID;
  861. procedure SetupParameters(out aBuildWithGlu: Boolean);
  862. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  863. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method
  864. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  865. function FlipHorz: Boolean; virtual;
  866. function FlipVert: Boolean; virtual;
  867. property Width: Integer read GetWidth;
  868. property Height: Integer read GetHeight;
  869. property FileWidth: Integer read GetFileWidth;
  870. property FileHeight: Integer read GetFileHeight;
  871. public
  872. //Properties
  873. property ID: Cardinal read fID write SetID;
  874. property Target: Cardinal read fTarget write SetTarget;
  875. property Format: TglBitmapFormat read fFormat write SetFormat;
  876. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  877. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  878. property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc;
  879. property Filename: String read fFilename;
  880. property CustomName: String read fCustomName write SetCustomName;
  881. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  882. property CustomData: Pointer read fCustomData write SetCustomData;
  883. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  884. property FreeDataOnDestroy: Boolean read fFreeDataOnDestroy write SetFreeDataOnDestroy;
  885. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  886. property Dimension: TglBitmapPixelPosition read fDimension;
  887. property Data: PByte read fData;
  888. property IsResident: GLboolean read fIsResident;
  889. procedure AfterConstruction; override;
  890. procedure BeforeDestruction; override;
  891. procedure PrepareResType(var aResource: String; var aResType: PChar);
  892. //Load
  893. procedure LoadFromFile(const aFilename: String);
  894. procedure LoadFromStream(const aStream: TStream); virtual;
  895. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  896. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  897. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  898. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  899. //Save
  900. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  901. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  902. //Convert
  903. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  904. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  905. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  906. public
  907. //Alpha & Co
  908. {$IFDEF GLB_SDL}
  909. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  910. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  911. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  912. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  913. const aArgs: Pointer = nil): Boolean;
  914. {$ENDIF}
  915. {$IFDEF GLB_DELPHI}
  916. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  917. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  918. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  919. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  920. const aArgs: Pointer = nil): Boolean;
  921. {$ENDIF}
  922. {$IFDEF GLB_LAZARUS}
  923. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  924. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  925. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  926. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  927. const aArgs: Pointer = nil): Boolean;
  928. {$ENDIF}
  929. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  930. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  931. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  932. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  933. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  934. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  935. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  936. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  937. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  938. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  939. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  940. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  941. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  942. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  943. function RemoveAlpha: Boolean; virtual;
  944. public
  945. //Common
  946. function Clone: TglBitmap;
  947. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  948. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  949. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  950. procedure FreeData;
  951. //ColorFill
  952. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  953. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  954. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  955. //TexParameters
  956. procedure SetFilter(const aMin, aMag: GLenum);
  957. procedure SetWrap(
  958. const S: GLenum = GL_CLAMP_TO_EDGE;
  959. const T: GLenum = GL_CLAMP_TO_EDGE;
  960. const R: GLenum = GL_CLAMP_TO_EDGE);
  961. procedure SetSwizzle(const r, g, b, a: GLenum);
  962. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  963. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  964. //Constructors
  965. constructor Create; overload;
  966. constructor Create(const aFileName: String); overload;
  967. constructor Create(const aStream: TStream); overload;
  968. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  969. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  970. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  971. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  972. private
  973. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  974. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  975. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  976. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  977. function LoadBMP(const aStream: TStream): Boolean; virtual;
  978. procedure SaveBMP(const aStream: TStream); virtual;
  979. function LoadTGA(const aStream: TStream): Boolean; virtual;
  980. procedure SaveTGA(const aStream: TStream); virtual;
  981. function LoadDDS(const aStream: TStream): Boolean; virtual;
  982. procedure SaveDDS(const aStream: TStream); virtual;
  983. end;
  984. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  985. TglBitmap1D = class(TglBitmap)
  986. protected
  987. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  988. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  989. procedure UploadData(const aBuildWithGlu: Boolean);
  990. public
  991. property Width;
  992. procedure AfterConstruction; override;
  993. function FlipHorz: Boolean; override;
  994. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  995. end;
  996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  997. TglBitmap2D = class(TglBitmap)
  998. protected
  999. fLines: array of PByte;
  1000. function GetScanline(const aIndex: Integer): Pointer;
  1001. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  1002. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  1003. procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  1004. public
  1005. property Width;
  1006. property Height;
  1007. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  1008. procedure AfterConstruction; override;
  1009. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  1010. procedure GetDataFromTexture;
  1011. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  1012. function FlipHorz: Boolean; override;
  1013. function FlipVert: Boolean; override;
  1014. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  1015. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  1016. end;
  1017. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1018. TglBitmapCubeMap = class(TglBitmap2D)
  1019. protected
  1020. fGenMode: Integer;
  1021. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  1022. public
  1023. procedure AfterConstruction; override;
  1024. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  1025. procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  1026. procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  1027. end;
  1028. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1029. TglBitmapNormalMap = class(TglBitmapCubeMap)
  1030. public
  1031. procedure AfterConstruction; override;
  1032. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  1033. end;
  1034. TglcBitmapFormat = TglBitmapFormat;
  1035. TglcBitmap1D = TglBitmap1D;
  1036. TglcBitmap2D = TglBitmap2D;
  1037. TglcBitmapCubeMap = TglBitmapCubeMap;
  1038. TglcBitmapNormalMap = TglBitmapNormalMap;
  1039. const
  1040. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1041. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1042. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1043. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1044. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1045. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1046. procedure glBitmapSetDefaultWrap(
  1047. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1048. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1049. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1050. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1051. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1052. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1053. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1054. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1055. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1056. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1057. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1058. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1059. var
  1060. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1061. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1062. glBitmapDefaultFormat: TglBitmapFormat;
  1063. glBitmapDefaultMipmap: TglBitmapMipMap;
  1064. glBitmapDefaultFilterMin: Cardinal;
  1065. glBitmapDefaultFilterMag: Cardinal;
  1066. glBitmapDefaultWrapS: Cardinal;
  1067. glBitmapDefaultWrapT: Cardinal;
  1068. glBitmapDefaultWrapR: Cardinal;
  1069. glDefaultSwizzle: array[0..3] of GLenum;
  1070. {$IFDEF GLB_DELPHI}
  1071. function CreateGrayPalette: HPALETTE;
  1072. {$ENDIF}
  1073. implementation
  1074. uses
  1075. Math, syncobjs, typinfo
  1076. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1077. type
  1078. {$IFNDEF fpc}
  1079. QWord = System.UInt64;
  1080. PQWord = ^QWord;
  1081. PtrInt = Longint;
  1082. PtrUInt = DWord;
  1083. {$ENDIF}
  1084. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1085. TShiftRec = packed record
  1086. case Integer of
  1087. 0: (r, g, b, a: Byte);
  1088. 1: (arr: array[0..3] of Byte);
  1089. end;
  1090. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1091. private
  1092. function GetRedMask: QWord;
  1093. function GetGreenMask: QWord;
  1094. function GetBlueMask: QWord;
  1095. function GetAlphaMask: QWord;
  1096. protected
  1097. fFormat: TglBitmapFormat;
  1098. fWithAlpha: TglBitmapFormat;
  1099. fWithoutAlpha: TglBitmapFormat;
  1100. fOpenGLFormat: TglBitmapFormat;
  1101. fRGBInverted: TglBitmapFormat;
  1102. fUncompressed: TglBitmapFormat;
  1103. fPixelSize: Single;
  1104. fIsCompressed: Boolean;
  1105. fRange: TglBitmapColorRec;
  1106. fShift: TShiftRec;
  1107. fglFormat: GLenum;
  1108. fglInternalFormat: GLenum;
  1109. fglDataFormat: GLenum;
  1110. function GetIsCompressed: Boolean; override;
  1111. function GetHasRed: Boolean; override;
  1112. function GetHasGreen: Boolean; override;
  1113. function GetHasBlue: Boolean; override;
  1114. function GetHasAlpha: Boolean; override;
  1115. function GetRGBInverted: TglBitmapFormat; override;
  1116. function GetWithAlpha: TglBitmapFormat; override;
  1117. function GetWithoutAlpha: TglBitmapFormat; override;
  1118. function GetOpenGLFormat: TglBitmapFormat; override;
  1119. function GetUncompressed: TglBitmapFormat; override;
  1120. function GetglFormat: GLenum; override;
  1121. function GetglInternalFormat: GLenum; override;
  1122. function GetglDataFormat: GLenum; override;
  1123. function GetComponents: Integer; virtual;
  1124. public
  1125. property Format: TglBitmapFormat read fFormat;
  1126. property Components: Integer read GetComponents;
  1127. property PixelSize: Single read fPixelSize;
  1128. property Range: TglBitmapColorRec read fRange;
  1129. property Shift: TShiftRec read fShift;
  1130. property RedMask: QWord read GetRedMask;
  1131. property GreenMask: QWord read GetGreenMask;
  1132. property BlueMask: QWord read GetBlueMask;
  1133. property AlphaMask: QWord read GetAlphaMask;
  1134. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1135. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1136. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1137. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1138. function CreateMappingData: Pointer; virtual;
  1139. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1140. function IsEmpty: Boolean; virtual;
  1141. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  1142. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1143. constructor Create; virtual;
  1144. public
  1145. class procedure Init;
  1146. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1147. class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1148. class procedure Clear;
  1149. class procedure Finalize;
  1150. end;
  1151. TFormatDescriptorClass = class of TFormatDescriptor;
  1152. TfdEmpty = class(TFormatDescriptor);
  1153. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1154. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1155. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1156. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1157. end;
  1158. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1159. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1160. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1161. end;
  1162. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1163. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1164. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1165. end;
  1166. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1167. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1168. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1169. end;
  1170. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1171. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1172. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1173. end;
  1174. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1175. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1176. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1177. end;
  1178. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1179. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  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. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  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. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  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. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  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. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  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. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  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. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1204. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1205. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1206. end;
  1207. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1208. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1209. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1210. end;
  1211. TfdARGB_US4 = class(TfdRGB_US3) //4* unsigned short
  1212. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1213. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1214. end;
  1215. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1216. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1217. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1218. end;
  1219. TfdABGR_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1220. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1221. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1222. end;
  1223. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1224. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  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. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  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. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1233. TfdAlpha4 = class(TfdAlpha_UB1)
  1234. constructor Create; override;
  1235. end;
  1236. TfdAlpha8 = class(TfdAlpha_UB1)
  1237. constructor Create; override;
  1238. end;
  1239. TfdAlpha16 = class(TfdAlpha_US1)
  1240. constructor Create; override;
  1241. end;
  1242. TfdLuminance4 = class(TfdLuminance_UB1)
  1243. constructor Create; override;
  1244. end;
  1245. TfdLuminance8 = class(TfdLuminance_UB1)
  1246. constructor Create; override;
  1247. end;
  1248. TfdLuminance16 = class(TfdLuminance_US1)
  1249. constructor Create; override;
  1250. end;
  1251. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1252. constructor Create; override;
  1253. end;
  1254. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1255. constructor Create; override;
  1256. end;
  1257. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1258. constructor Create; override;
  1259. end;
  1260. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1261. constructor Create; override;
  1262. end;
  1263. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1264. constructor Create; override;
  1265. end;
  1266. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1267. TfdR3G3B2 = class(TfdUniversal_UB1)
  1268. constructor Create; override;
  1269. end;
  1270. TfdRGBX4 = class(TfdUniversal_US1)
  1271. constructor Create; override;
  1272. end;
  1273. TfdXRGB4 = class(TfdUniversal_US1)
  1274. constructor Create; override;
  1275. end;
  1276. TfdR5G6B5 = class(TfdUniversal_US1)
  1277. constructor Create; override;
  1278. end;
  1279. TfdRGB5X1 = class(TfdUniversal_US1)
  1280. constructor Create; override;
  1281. end;
  1282. TfdX1RGB5 = class(TfdUniversal_US1)
  1283. constructor Create; override;
  1284. end;
  1285. TfdRGB8 = class(TfdRGB_UB3)
  1286. constructor Create; override;
  1287. end;
  1288. TfdRGBX8 = class(TfdUniversal_UI1)
  1289. constructor Create; override;
  1290. end;
  1291. TfdXRGB8 = class(TfdUniversal_UI1)
  1292. constructor Create; override;
  1293. end;
  1294. TfdRGB10X2 = class(TfdUniversal_UI1)
  1295. constructor Create; override;
  1296. end;
  1297. TfdX2RGB10 = class(TfdUniversal_UI1)
  1298. constructor Create; override;
  1299. end;
  1300. TfdRGB16 = class(TfdRGB_US3)
  1301. constructor Create; override;
  1302. end;
  1303. TfdRGBA4 = class(TfdUniversal_US1)
  1304. constructor Create; override;
  1305. end;
  1306. TfdARGB4 = class(TfdUniversal_US1)
  1307. constructor Create; override;
  1308. end;
  1309. TfdRGB5A1 = class(TfdUniversal_US1)
  1310. constructor Create; override;
  1311. end;
  1312. TfdA1RGB5 = class(TfdUniversal_US1)
  1313. constructor Create; override;
  1314. end;
  1315. TfdRGBA8 = class(TfdUniversal_UI1)
  1316. constructor Create; override;
  1317. end;
  1318. TfdARGB8 = class(TfdUniversal_UI1)
  1319. constructor Create; override;
  1320. end;
  1321. TfdRGB10A2 = class(TfdUniversal_UI1)
  1322. constructor Create; override;
  1323. end;
  1324. TfdA2RGB10 = class(TfdUniversal_UI1)
  1325. constructor Create; override;
  1326. end;
  1327. TfdRGBA16 = class(TfdUniversal_UI1)
  1328. constructor Create; override;
  1329. end;
  1330. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1331. TfdBGRX4 = class(TfdUniversal_US1)
  1332. constructor Create; override;
  1333. end;
  1334. TfdXBGR4 = class(TfdUniversal_US1)
  1335. constructor Create; override;
  1336. end;
  1337. TfdB5G6R5 = class(TfdUniversal_US1)
  1338. constructor Create; override;
  1339. end;
  1340. TfdBGR5X1 = class(TfdUniversal_US1)
  1341. constructor Create; override;
  1342. end;
  1343. TfdX1BGR5 = class(TfdUniversal_US1)
  1344. constructor Create; override;
  1345. end;
  1346. TfdBGR8 = class(TfdBGR_UB3)
  1347. constructor Create; override;
  1348. end;
  1349. TfdBGRX8 = class(TfdUniversal_UI1)
  1350. constructor Create; override;
  1351. end;
  1352. TfdXBGR8 = class(TfdUniversal_UI1)
  1353. constructor Create; override;
  1354. end;
  1355. TfdBGR10X2 = class(TfdUniversal_UI1)
  1356. constructor Create; override;
  1357. end;
  1358. TfdX2BGR10 = class(TfdUniversal_UI1)
  1359. constructor Create; override;
  1360. end;
  1361. TfdBGR16 = class(TfdBGR_US3)
  1362. constructor Create; override;
  1363. end;
  1364. TfdBGRA4 = class(TfdUniversal_US1)
  1365. constructor Create; override;
  1366. end;
  1367. TfdABGR4 = class(TfdUniversal_US1)
  1368. constructor Create; override;
  1369. end;
  1370. TfdBGR5A1 = class(TfdUniversal_US1)
  1371. constructor Create; override;
  1372. end;
  1373. TfdA1BGR5 = class(TfdUniversal_US1)
  1374. constructor Create; override;
  1375. end;
  1376. TfdBGRA8 = class(TfdUniversal_UI1)
  1377. constructor Create; override;
  1378. end;
  1379. TfdABGR8 = class(TfdUniversal_UI1)
  1380. constructor Create; override;
  1381. end;
  1382. TfdBGR10A2 = class(TfdUniversal_UI1)
  1383. constructor Create; override;
  1384. end;
  1385. TfdA2BGR10 = class(TfdUniversal_UI1)
  1386. constructor Create; override;
  1387. end;
  1388. TfdBGRA16 = class(TfdBGRA_US4)
  1389. constructor Create; override;
  1390. end;
  1391. TfdDepth16 = class(TfdDepth_US1)
  1392. constructor Create; override;
  1393. end;
  1394. TfdDepth24 = class(TfdDepth_UI1)
  1395. constructor Create; override;
  1396. end;
  1397. TfdDepth32 = class(TfdDepth_UI1)
  1398. constructor Create; override;
  1399. end;
  1400. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1401. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1402. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1403. constructor Create; override;
  1404. end;
  1405. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1406. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1407. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1408. constructor Create; override;
  1409. end;
  1410. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1411. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1412. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1413. constructor Create; override;
  1414. end;
  1415. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1416. TbmpBitfieldFormat = class(TFormatDescriptor)
  1417. private
  1418. procedure SetRedMask (const aValue: QWord);
  1419. procedure SetGreenMask(const aValue: QWord);
  1420. procedure SetBlueMask (const aValue: QWord);
  1421. procedure SetAlphaMask(const aValue: QWord);
  1422. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1423. public
  1424. property RedMask: QWord read GetRedMask write SetRedMask;
  1425. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1426. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1427. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1428. property PixelSize: Single read fPixelSize write fPixelSize;
  1429. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1430. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1431. end;
  1432. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1433. TbmpColorTableEnty = packed record
  1434. b, g, r, a: Byte;
  1435. end;
  1436. TbmpColorTable = array of TbmpColorTableEnty;
  1437. TbmpColorTableFormat = class(TFormatDescriptor)
  1438. private
  1439. fColorTable: TbmpColorTable;
  1440. public
  1441. property PixelSize: Single read fPixelSize write fPixelSize;
  1442. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1443. property Range: TglBitmapColorRec read fRange write fRange;
  1444. property Shift: TShiftRec read fShift write fShift;
  1445. property Format: TglBitmapFormat read fFormat write fFormat;
  1446. procedure CreateColorTable;
  1447. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1448. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1449. destructor Destroy; override;
  1450. end;
  1451. const
  1452. LUMINANCE_WEIGHT_R = 0.30;
  1453. LUMINANCE_WEIGHT_G = 0.59;
  1454. LUMINANCE_WEIGHT_B = 0.11;
  1455. ALPHA_WEIGHT_R = 0.30;
  1456. ALPHA_WEIGHT_G = 0.59;
  1457. ALPHA_WEIGHT_B = 0.11;
  1458. DEPTH_WEIGHT_R = 0.333333333;
  1459. DEPTH_WEIGHT_G = 0.333333333;
  1460. DEPTH_WEIGHT_B = 0.333333333;
  1461. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1462. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1463. TfdEmpty,
  1464. TfdAlpha4,
  1465. TfdAlpha8,
  1466. TfdAlpha16,
  1467. TfdLuminance4,
  1468. TfdLuminance8,
  1469. TfdLuminance16,
  1470. TfdLuminance4Alpha4,
  1471. TfdLuminance6Alpha2,
  1472. TfdLuminance8Alpha8,
  1473. TfdLuminance12Alpha4,
  1474. TfdLuminance16Alpha16,
  1475. TfdR3G3B2,
  1476. TfdRGBX4,
  1477. TfdXRGB4,
  1478. TfdR5G6B5,
  1479. TfdRGB5X1,
  1480. TfdX1RGB5,
  1481. TfdRGB8,
  1482. TfdRGBX8,
  1483. TfdXRGB8,
  1484. TfdRGB10X2,
  1485. TfdX2RGB10,
  1486. TfdRGB16,
  1487. TfdRGBA4,
  1488. TfdARGB4,
  1489. TfdRGB5A1,
  1490. TfdA1RGB5,
  1491. TfdRGBA8,
  1492. TfdARGB8,
  1493. TfdRGB10A2,
  1494. TfdA2RGB10,
  1495. TfdRGBA16,
  1496. TfdBGRX4,
  1497. TfdXBGR4,
  1498. TfdB5G6R5,
  1499. TfdBGR5X1,
  1500. TfdX1BGR5,
  1501. TfdBGR8,
  1502. TfdBGRX8,
  1503. TfdXBGR8,
  1504. TfdBGR10X2,
  1505. TfdX2BGR10,
  1506. TfdBGR16,
  1507. TfdBGRA4,
  1508. TfdABGR4,
  1509. TfdBGR5A1,
  1510. TfdA1BGR5,
  1511. TfdBGRA8,
  1512. TfdABGR8,
  1513. TfdBGR10A2,
  1514. TfdA2BGR10,
  1515. TfdBGRA16,
  1516. TfdDepth16,
  1517. TfdDepth24,
  1518. TfdDepth32,
  1519. TfdS3tcDtx1RGBA,
  1520. TfdS3tcDtx3RGBA,
  1521. TfdS3tcDtx5RGBA
  1522. );
  1523. var
  1524. FormatDescriptorCS: TCriticalSection;
  1525. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1526. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1527. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1528. begin
  1529. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1530. end;
  1531. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1532. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1533. begin
  1534. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1535. end;
  1536. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1537. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1538. begin
  1539. result.Fields := [];
  1540. if X >= 0 then
  1541. result.Fields := result.Fields + [ffX];
  1542. if Y >= 0 then
  1543. result.Fields := result.Fields + [ffY];
  1544. result.X := Max(0, X);
  1545. result.Y := Max(0, Y);
  1546. end;
  1547. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1548. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1549. begin
  1550. result.r := r;
  1551. result.g := g;
  1552. result.b := b;
  1553. result.a := a;
  1554. end;
  1555. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1556. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1557. var
  1558. i: Integer;
  1559. begin
  1560. result := false;
  1561. for i := 0 to high(r1.arr) do
  1562. if (r1.arr[i] <> r2.arr[i]) then
  1563. exit;
  1564. result := true;
  1565. end;
  1566. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1567. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1568. begin
  1569. result.r := r;
  1570. result.g := g;
  1571. result.b := b;
  1572. result.a := a;
  1573. end;
  1574. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1575. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1576. begin
  1577. result := [];
  1578. if (aFormat in [
  1579. //4 bbp
  1580. tfLuminance4,
  1581. //8bpp
  1582. tfR3G3B2, tfLuminance8,
  1583. //16bpp
  1584. tfRGBX4, tfXRGB4, tfRGB5X1, tfX1RGB5, tfR5G6B5, tfRGB5A1, tfA1RGB5, tfRGBA4, tfARGB4,
  1585. tfBGRX4, tfXBGR4, tfBGR5X1, tfX1BGR5, tfB5G6R5, tfBGR5A1, tfA1BGR5, tfBGRA4, tfABGR4,
  1586. //24bpp
  1587. tfBGR8, tfRGB8,
  1588. //32bpp
  1589. tfRGB10X2, tfX2RGB10, tfRGB10A2, tfA2RGB10, tfRGBA8, tfARGB8,
  1590. tfBGR10X2, tfX2BGR10, tfBGR10A2, tfA2BGR10, tfBGRA8, tfABGR8]) then
  1591. result := result + [ftBMP];
  1592. if (aFormat in [
  1593. //8 bpp
  1594. tfLuminance8, tfAlpha8,
  1595. //16 bpp
  1596. tfLuminance16, tfLuminance8Alpha8,
  1597. tfRGB5X1, tfX1RGB5, tfRGB5A1, tfA1RGB5, tfRGBA4, tfARGB4,
  1598. tfBGR5X1, tfX1BGR5, tfBGR5A1, tfA1BGR5, tfBGRA4, tfABGR4,
  1599. //24 bpp
  1600. tfRGB8, tfBGR8,
  1601. //32 bpp
  1602. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1603. result := result + [ftTGA];
  1604. if (aFormat in [
  1605. //8 bpp
  1606. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1607. tfR3G3B2,
  1608. //16 bpp
  1609. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1610. tfRGBX4, tfXRGB4, tfR5G6B5, tfRGB5X1, tfX1RGB5, tfRGBA4, tfARGB4, tfRGB5A1, tfA1RGB5,
  1611. tfBGRX4, tfXBGR4, tfB5G6R5, tfBGR5X1, tfX1BGR5, tfBGRA4, tfABGR4, tfBGR5A1, tfA1BGR5,
  1612. //24 bpp
  1613. tfRGB8, tfBGR8,
  1614. //32 bbp
  1615. tfLuminance16Alpha16,
  1616. tfRGBA8, tfRGB10A2,
  1617. tfBGRA8, tfBGR10A2,
  1618. //compressed
  1619. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1620. result := result + [ftDDS];
  1621. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1622. if aFormat in [
  1623. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1624. tfRGB8, tfRGBA8,
  1625. tfBGR8, tfBGRA8] then
  1626. result := result + [ftPNG];
  1627. {$ENDIF}
  1628. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1629. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1630. result := result + [ftJPEG];
  1631. {$ENDIF}
  1632. end;
  1633. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1634. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1635. begin
  1636. while (aNumber and 1) = 0 do
  1637. aNumber := aNumber shr 1;
  1638. result := aNumber = 1;
  1639. end;
  1640. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1641. function GetTopMostBit(aBitSet: QWord): Integer;
  1642. begin
  1643. result := 0;
  1644. while aBitSet > 0 do begin
  1645. inc(result);
  1646. aBitSet := aBitSet shr 1;
  1647. end;
  1648. end;
  1649. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1650. function CountSetBits(aBitSet: QWord): Integer;
  1651. begin
  1652. result := 0;
  1653. while aBitSet > 0 do begin
  1654. if (aBitSet and 1) = 1 then
  1655. inc(result);
  1656. aBitSet := aBitSet shr 1;
  1657. end;
  1658. end;
  1659. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1660. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1661. begin
  1662. result := Trunc(
  1663. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1664. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1665. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1666. end;
  1667. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1668. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1669. begin
  1670. result := Trunc(
  1671. DEPTH_WEIGHT_R * aPixel.Data.r +
  1672. DEPTH_WEIGHT_G * aPixel.Data.g +
  1673. DEPTH_WEIGHT_B * aPixel.Data.b);
  1674. end;
  1675. {$IFDEF GLB_NATIVE_OGL}
  1676. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1677. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1678. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1679. var
  1680. GL_LibHandle: Pointer = nil;
  1681. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
  1682. begin
  1683. if not Assigned(aLibHandle) then
  1684. aLibHandle := GL_LibHandle;
  1685. {$IF DEFINED(GLB_WIN)}
  1686. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1687. if Assigned(result) then
  1688. exit;
  1689. if Assigned(wglGetProcAddress) then
  1690. result := wglGetProcAddress(aProcName);
  1691. {$ELSEIF DEFINED(GLB_LINUX)}
  1692. if Assigned(glXGetProcAddress) then begin
  1693. result := glXGetProcAddress(aProcName);
  1694. if Assigned(result) then
  1695. exit;
  1696. end;
  1697. if Assigned(glXGetProcAddressARB) then begin
  1698. result := glXGetProcAddressARB(aProcName);
  1699. if Assigned(result) then
  1700. exit;
  1701. end;
  1702. result := dlsym(aLibHandle, aProcName);
  1703. {$IFEND}
  1704. if not Assigned(result) and aRaiseOnErr then
  1705. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1706. end;
  1707. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1708. var
  1709. GLU_LibHandle: Pointer = nil;
  1710. OpenGLInitialized: Boolean;
  1711. InitOpenGLCS: TCriticalSection;
  1712. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1713. procedure glbInitOpenGL;
  1714. ////////////////////////////////////////////////////////////////////////////////
  1715. function glbLoadLibrary(const aName: PChar): Pointer;
  1716. begin
  1717. {$IF DEFINED(GLB_WIN)}
  1718. result := {%H-}Pointer(LoadLibrary(aName));
  1719. {$ELSEIF DEFINED(GLB_LINUX)}
  1720. result := dlopen(Name, RTLD_LAZY);
  1721. {$ELSE}
  1722. result := nil;
  1723. {$IFEND}
  1724. end;
  1725. ////////////////////////////////////////////////////////////////////////////////
  1726. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1727. begin
  1728. result := false;
  1729. if not Assigned(aLibHandle) then
  1730. exit;
  1731. {$IF DEFINED(GLB_WIN)}
  1732. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1733. {$ELSEIF DEFINED(GLB_LINUX)}
  1734. Result := dlclose(aLibHandle) = 0;
  1735. {$IFEND}
  1736. end;
  1737. begin
  1738. if Assigned(GL_LibHandle) then
  1739. glbFreeLibrary(GL_LibHandle);
  1740. if Assigned(GLU_LibHandle) then
  1741. glbFreeLibrary(GLU_LibHandle);
  1742. GL_LibHandle := glbLoadLibrary(libopengl);
  1743. if not Assigned(GL_LibHandle) then
  1744. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1745. GLU_LibHandle := glbLoadLibrary(libglu);
  1746. if not Assigned(GLU_LibHandle) then
  1747. raise EglBitmap.Create('unable to load library: ' + libglu);
  1748. {$IF DEFINED(GLB_WIN)}
  1749. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1750. {$ELSEIF DEFINED(GLB_LINUX)}
  1751. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1752. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1753. {$IFEND}
  1754. glEnable := glbGetProcAddress('glEnable');
  1755. glDisable := glbGetProcAddress('glDisable');
  1756. glGetString := glbGetProcAddress('glGetString');
  1757. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1758. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1759. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1760. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1761. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1762. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1763. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1764. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1765. glTexGeni := glbGetProcAddress('glTexGeni');
  1766. glGenTextures := glbGetProcAddress('glGenTextures');
  1767. glBindTexture := glbGetProcAddress('glBindTexture');
  1768. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1769. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1770. glReadPixels := glbGetProcAddress('glReadPixels');
  1771. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1772. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1773. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1774. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1775. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1776. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1777. end;
  1778. {$ENDIF}
  1779. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1780. procedure glbReadOpenGLExtensions;
  1781. var
  1782. Buffer: AnsiString;
  1783. MajorVersion, MinorVersion: Integer;
  1784. ///////////////////////////////////////////////////////////////////////////////////////////
  1785. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1786. var
  1787. Separator: Integer;
  1788. begin
  1789. aMinor := 0;
  1790. aMajor := 0;
  1791. Separator := Pos(AnsiString('.'), aBuffer);
  1792. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1793. (aBuffer[Separator - 1] in ['0'..'9']) and
  1794. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1795. Dec(Separator);
  1796. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1797. Dec(Separator);
  1798. Delete(aBuffer, 1, Separator);
  1799. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1800. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1801. Inc(Separator);
  1802. Delete(aBuffer, Separator, 255);
  1803. Separator := Pos(AnsiString('.'), aBuffer);
  1804. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1805. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1806. end;
  1807. end;
  1808. ///////////////////////////////////////////////////////////////////////////////////////////
  1809. function CheckExtension(const Extension: AnsiString): Boolean;
  1810. var
  1811. ExtPos: Integer;
  1812. begin
  1813. ExtPos := Pos(Extension, Buffer);
  1814. result := ExtPos > 0;
  1815. if result then
  1816. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1817. end;
  1818. ///////////////////////////////////////////////////////////////////////////////////////////
  1819. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1820. begin
  1821. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1822. end;
  1823. begin
  1824. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1825. InitOpenGLCS.Enter;
  1826. try
  1827. if not OpenGLInitialized then begin
  1828. glbInitOpenGL;
  1829. OpenGLInitialized := true;
  1830. end;
  1831. finally
  1832. InitOpenGLCS.Leave;
  1833. end;
  1834. {$ENDIF}
  1835. // Version
  1836. Buffer := glGetString(GL_VERSION);
  1837. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1838. GL_VERSION_1_2 := CheckVersion(1, 2);
  1839. GL_VERSION_1_3 := CheckVersion(1, 3);
  1840. GL_VERSION_1_4 := CheckVersion(1, 4);
  1841. GL_VERSION_2_0 := CheckVersion(2, 0);
  1842. GL_VERSION_3_3 := CheckVersion(3, 3);
  1843. // Extensions
  1844. Buffer := glGetString(GL_EXTENSIONS);
  1845. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1846. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1847. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1848. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1849. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1850. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1851. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1852. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1853. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1854. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1855. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1856. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1857. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1858. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1859. if GL_VERSION_1_3 then begin
  1860. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1861. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1862. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1863. end else begin
  1864. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false);
  1865. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false);
  1866. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
  1867. end;
  1868. end;
  1869. {$ENDIF}
  1870. {$IFDEF GLB_SDL_IMAGE}
  1871. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1872. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1873. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1874. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1875. begin
  1876. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1877. end;
  1878. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1879. begin
  1880. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1881. end;
  1882. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1883. begin
  1884. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1885. end;
  1886. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1887. begin
  1888. result := 0;
  1889. end;
  1890. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1891. begin
  1892. result := SDL_AllocRW;
  1893. if result = nil then
  1894. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1895. result^.seek := glBitmapRWseek;
  1896. result^.read := glBitmapRWread;
  1897. result^.write := glBitmapRWwrite;
  1898. result^.close := glBitmapRWclose;
  1899. result^.unknown.data1 := Stream;
  1900. end;
  1901. {$ENDIF}
  1902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1903. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1904. begin
  1905. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1906. end;
  1907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1908. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1909. begin
  1910. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1911. end;
  1912. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1913. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1914. begin
  1915. glBitmapDefaultMipmap := aValue;
  1916. end;
  1917. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1918. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1919. begin
  1920. glBitmapDefaultFormat := aFormat;
  1921. end;
  1922. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1923. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1924. begin
  1925. glBitmapDefaultFilterMin := aMin;
  1926. glBitmapDefaultFilterMag := aMag;
  1927. end;
  1928. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1929. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1930. begin
  1931. glBitmapDefaultWrapS := S;
  1932. glBitmapDefaultWrapT := T;
  1933. glBitmapDefaultWrapR := R;
  1934. end;
  1935. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1936. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1937. begin
  1938. glDefaultSwizzle[0] := r;
  1939. glDefaultSwizzle[1] := g;
  1940. glDefaultSwizzle[2] := b;
  1941. glDefaultSwizzle[3] := a;
  1942. end;
  1943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1944. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1945. begin
  1946. result := glBitmapDefaultDeleteTextureOnFree;
  1947. end;
  1948. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1949. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1950. begin
  1951. result := glBitmapDefaultFreeDataAfterGenTextures;
  1952. end;
  1953. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1954. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1955. begin
  1956. result := glBitmapDefaultMipmap;
  1957. end;
  1958. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1959. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1960. begin
  1961. result := glBitmapDefaultFormat;
  1962. end;
  1963. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1964. procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
  1965. begin
  1966. aMin := glBitmapDefaultFilterMin;
  1967. aMag := glBitmapDefaultFilterMag;
  1968. end;
  1969. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1970. procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
  1971. begin
  1972. S := glBitmapDefaultWrapS;
  1973. T := glBitmapDefaultWrapT;
  1974. R := glBitmapDefaultWrapR;
  1975. end;
  1976. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1977. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1978. begin
  1979. r := glDefaultSwizzle[0];
  1980. g := glDefaultSwizzle[1];
  1981. b := glDefaultSwizzle[2];
  1982. a := glDefaultSwizzle[3];
  1983. end;
  1984. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1985. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1986. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1987. function TFormatDescriptor.GetRedMask: QWord;
  1988. begin
  1989. result := fRange.r shl fShift.r;
  1990. end;
  1991. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1992. function TFormatDescriptor.GetGreenMask: QWord;
  1993. begin
  1994. result := fRange.g shl fShift.g;
  1995. end;
  1996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1997. function TFormatDescriptor.GetBlueMask: QWord;
  1998. begin
  1999. result := fRange.b shl fShift.b;
  2000. end;
  2001. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2002. function TFormatDescriptor.GetAlphaMask: QWord;
  2003. begin
  2004. result := fRange.a shl fShift.a;
  2005. end;
  2006. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2007. function TFormatDescriptor.GetIsCompressed: Boolean;
  2008. begin
  2009. result := fIsCompressed;
  2010. end;
  2011. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2012. function TFormatDescriptor.GetHasRed: Boolean;
  2013. begin
  2014. result := (fRange.r > 0);
  2015. end;
  2016. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2017. function TFormatDescriptor.GetHasGreen: Boolean;
  2018. begin
  2019. result := (fRange.g > 0);
  2020. end;
  2021. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2022. function TFormatDescriptor.GetHasBlue: Boolean;
  2023. begin
  2024. result := (fRange.b > 0);
  2025. end;
  2026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2027. function TFormatDescriptor.GetHasAlpha: Boolean;
  2028. begin
  2029. result := (fRange.a > 0);
  2030. end;
  2031. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2032. function TFormatDescriptor.GetRGBInverted: TglBitmapFormat;
  2033. begin
  2034. result := fRGBInverted;
  2035. end;
  2036. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2037. function TFormatDescriptor.GetWithAlpha: TglBitmapFormat;
  2038. begin
  2039. result := fWithAlpha;
  2040. end;
  2041. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2042. function TFormatDescriptor.GetWithoutAlpha: TglBitmapFormat;
  2043. begin
  2044. result := fWithoutAlpha;
  2045. end;
  2046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2047. function TFormatDescriptor.GetOpenGLFormat: TglBitmapFormat;
  2048. begin
  2049. result := fOpenGLFormat;
  2050. end;
  2051. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2052. function TFormatDescriptor.GetUncompressed: TglBitmapFormat;
  2053. begin
  2054. result := fUncompressed;
  2055. end;
  2056. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2057. function TFormatDescriptor.GetglFormat: GLenum;
  2058. begin
  2059. result := fglFormat;
  2060. end;
  2061. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2062. function TFormatDescriptor.GetglInternalFormat: GLenum;
  2063. begin
  2064. result := fglInternalFormat;
  2065. end;
  2066. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2067. function TFormatDescriptor.GetglDataFormat: GLenum;
  2068. begin
  2069. result := fglDataFormat;
  2070. end;
  2071. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2072. function TFormatDescriptor.GetComponents: Integer;
  2073. var
  2074. i: Integer;
  2075. begin
  2076. result := 0;
  2077. for i := 0 to 3 do
  2078. if (fRange.arr[i] > 0) then
  2079. inc(result);
  2080. end;
  2081. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2082. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  2083. var
  2084. w, h: Integer;
  2085. begin
  2086. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  2087. w := Max(1, aSize.X);
  2088. h := Max(1, aSize.Y);
  2089. result := GetSize(w, h);
  2090. end else
  2091. result := 0;
  2092. end;
  2093. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2094. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  2095. begin
  2096. result := 0;
  2097. if (aWidth <= 0) or (aHeight <= 0) then
  2098. exit;
  2099. result := Ceil(aWidth * aHeight * fPixelSize);
  2100. end;
  2101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2102. function TFormatDescriptor.CreateMappingData: Pointer;
  2103. begin
  2104. result := nil;
  2105. end;
  2106. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2107. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2108. begin
  2109. //DUMMY
  2110. end;
  2111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2112. function TFormatDescriptor.IsEmpty: Boolean;
  2113. begin
  2114. result := (fFormat = tfEmpty);
  2115. end;
  2116. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2117. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  2118. begin
  2119. result := false;
  2120. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2121. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2122. if (aRedMask <> RedMask) then
  2123. exit;
  2124. if (aGreenMask <> GreenMask) then
  2125. exit;
  2126. if (aBlueMask <> BlueMask) then
  2127. exit;
  2128. if (aAlphaMask <> AlphaMask) then
  2129. exit;
  2130. result := true;
  2131. end;
  2132. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2133. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2134. begin
  2135. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2136. aPixel.Data := fRange;
  2137. aPixel.Range := fRange;
  2138. aPixel.Format := fFormat;
  2139. end;
  2140. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2141. constructor TFormatDescriptor.Create;
  2142. begin
  2143. inherited Create;
  2144. fFormat := tfEmpty;
  2145. fWithAlpha := tfEmpty;
  2146. fWithoutAlpha := tfEmpty;
  2147. fOpenGLFormat := tfEmpty;
  2148. fRGBInverted := tfEmpty;
  2149. fUncompressed := tfEmpty;
  2150. fPixelSize := 0.0;
  2151. fIsCompressed := false;
  2152. fglFormat := 0;
  2153. fglInternalFormat := 0;
  2154. fglDataFormat := 0;
  2155. FillChar(fRange, 0, SizeOf(fRange));
  2156. FillChar(fShift, 0, SizeOf(fShift));
  2157. end;
  2158. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2159. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2160. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2161. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2162. begin
  2163. aData^ := aPixel.Data.a;
  2164. inc(aData);
  2165. end;
  2166. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2167. begin
  2168. aPixel.Data.r := 0;
  2169. aPixel.Data.g := 0;
  2170. aPixel.Data.b := 0;
  2171. aPixel.Data.a := aData^;
  2172. inc(aData);
  2173. end;
  2174. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2175. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2176. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2177. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2178. begin
  2179. aData^ := LuminanceWeight(aPixel);
  2180. inc(aData);
  2181. end;
  2182. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2183. begin
  2184. aPixel.Data.r := aData^;
  2185. aPixel.Data.g := aData^;
  2186. aPixel.Data.b := aData^;
  2187. aPixel.Data.a := 0;
  2188. inc(aData);
  2189. end;
  2190. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2191. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2192. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2193. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2194. var
  2195. i: Integer;
  2196. begin
  2197. aData^ := 0;
  2198. for i := 0 to 3 do
  2199. if (fRange.arr[i] > 0) then
  2200. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2201. inc(aData);
  2202. end;
  2203. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2204. var
  2205. i: Integer;
  2206. begin
  2207. for i := 0 to 3 do
  2208. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2209. inc(aData);
  2210. end;
  2211. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2212. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2213. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2214. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2215. begin
  2216. inherited Map(aPixel, aData, aMapData);
  2217. aData^ := aPixel.Data.a;
  2218. inc(aData);
  2219. end;
  2220. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2221. begin
  2222. inherited Unmap(aData, aPixel, aMapData);
  2223. aPixel.Data.a := aData^;
  2224. inc(aData);
  2225. end;
  2226. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2227. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2229. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2230. begin
  2231. aData^ := aPixel.Data.b;
  2232. inc(aData);
  2233. aData^ := aPixel.Data.g;
  2234. inc(aData);
  2235. aData^ := aPixel.Data.r;
  2236. inc(aData);
  2237. end;
  2238. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2239. begin
  2240. aPixel.Data.b := aData^;
  2241. inc(aData);
  2242. aPixel.Data.g := aData^;
  2243. inc(aData);
  2244. aPixel.Data.r := aData^;
  2245. inc(aData);
  2246. aPixel.Data.a := 0;
  2247. end;
  2248. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2249. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2250. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2251. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2252. begin
  2253. aData^ := aPixel.Data.r;
  2254. inc(aData);
  2255. aData^ := aPixel.Data.g;
  2256. inc(aData);
  2257. aData^ := aPixel.Data.b;
  2258. inc(aData);
  2259. end;
  2260. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2261. begin
  2262. aPixel.Data.r := aData^;
  2263. inc(aData);
  2264. aPixel.Data.g := aData^;
  2265. inc(aData);
  2266. aPixel.Data.b := aData^;
  2267. inc(aData);
  2268. aPixel.Data.a := 0;
  2269. end;
  2270. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2271. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2272. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2273. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2274. begin
  2275. PWord(aData)^ := aPixel.Data.a;
  2276. inc(aData, 2);
  2277. end;
  2278. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2279. begin
  2280. aPixel.Data.r := 0;
  2281. aPixel.Data.g := 0;
  2282. aPixel.Data.b := 0;
  2283. aPixel.Data.a := PWord(aData)^;
  2284. inc(aData, 2);
  2285. end;
  2286. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2287. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2288. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2289. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2290. begin
  2291. PWord(aData)^ := LuminanceWeight(aPixel);
  2292. inc(aData, 2);
  2293. end;
  2294. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2295. begin
  2296. aPixel.Data.r := PWord(aData)^;
  2297. aPixel.Data.g := PWord(aData)^;
  2298. aPixel.Data.b := PWord(aData)^;
  2299. aPixel.Data.a := 0;
  2300. inc(aData, 2);
  2301. end;
  2302. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2303. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2304. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2305. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2306. var
  2307. i: Integer;
  2308. begin
  2309. PWord(aData)^ := 0;
  2310. for i := 0 to 3 do
  2311. if (fRange.arr[i] > 0) then
  2312. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2313. inc(aData, 2);
  2314. end;
  2315. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2316. var
  2317. i: Integer;
  2318. begin
  2319. for i := 0 to 3 do
  2320. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2321. inc(aData, 2);
  2322. end;
  2323. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2324. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2325. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2326. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2327. begin
  2328. PWord(aData)^ := DepthWeight(aPixel);
  2329. inc(aData, 2);
  2330. end;
  2331. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2332. begin
  2333. aPixel.Data.r := PWord(aData)^;
  2334. aPixel.Data.g := PWord(aData)^;
  2335. aPixel.Data.b := PWord(aData)^;
  2336. aPixel.Data.a := PWord(aData)^;;
  2337. inc(aData, 2);
  2338. end;
  2339. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2340. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2341. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2342. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2343. begin
  2344. inherited Map(aPixel, aData, aMapData);
  2345. PWord(aData)^ := aPixel.Data.a;
  2346. inc(aData, 2);
  2347. end;
  2348. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2349. begin
  2350. inherited Unmap(aData, aPixel, aMapData);
  2351. aPixel.Data.a := PWord(aData)^;
  2352. inc(aData, 2);
  2353. end;
  2354. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2355. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2356. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2357. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2358. begin
  2359. PWord(aData)^ := aPixel.Data.b;
  2360. inc(aData, 2);
  2361. PWord(aData)^ := aPixel.Data.g;
  2362. inc(aData, 2);
  2363. PWord(aData)^ := aPixel.Data.r;
  2364. inc(aData, 2);
  2365. end;
  2366. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2367. begin
  2368. aPixel.Data.b := PWord(aData)^;
  2369. inc(aData, 2);
  2370. aPixel.Data.g := PWord(aData)^;
  2371. inc(aData, 2);
  2372. aPixel.Data.r := PWord(aData)^;
  2373. inc(aData, 2);
  2374. aPixel.Data.a := 0;
  2375. end;
  2376. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2377. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2378. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2379. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2380. begin
  2381. PWord(aData)^ := aPixel.Data.r;
  2382. inc(aData, 2);
  2383. PWord(aData)^ := aPixel.Data.g;
  2384. inc(aData, 2);
  2385. PWord(aData)^ := aPixel.Data.b;
  2386. inc(aData, 2);
  2387. end;
  2388. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2389. begin
  2390. aPixel.Data.r := PWord(aData)^;
  2391. inc(aData, 2);
  2392. aPixel.Data.g := PWord(aData)^;
  2393. inc(aData, 2);
  2394. aPixel.Data.b := PWord(aData)^;
  2395. inc(aData, 2);
  2396. aPixel.Data.a := 0;
  2397. end;
  2398. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2399. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2401. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2402. begin
  2403. PWord(aData)^ := aPixel.Data.a;
  2404. inc(aData, 2);
  2405. inherited Map(aPixel, aData, aMapData);
  2406. end;
  2407. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2408. begin
  2409. aPixel.Data.a := PWord(aData)^;
  2410. inc(aData, 2);
  2411. inherited Unmap(aData, aPixel, aMapData);
  2412. end;
  2413. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2414. //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2415. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2416. procedure TfdARGB_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2417. begin
  2418. inherited Map(aPixel, aData, aMapData);
  2419. PWord(aData)^ := aPixel.Data.a;
  2420. inc(aData, 2);
  2421. end;
  2422. procedure TfdARGB_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2423. begin
  2424. inherited Unmap(aData, aPixel, aMapData);
  2425. aPixel.Data.a := PWord(aData)^;
  2426. inc(aData, 2);
  2427. end;
  2428. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2429. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2430. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2431. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2432. begin
  2433. PWord(aData)^ := aPixel.Data.a;
  2434. inc(aData, 2);
  2435. inherited Map(aPixel, aData, aMapData);
  2436. end;
  2437. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2438. begin
  2439. aPixel.Data.a := PWord(aData)^;
  2440. inc(aData, 2);
  2441. inherited Unmap(aData, aPixel, aMapData);
  2442. end;
  2443. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2444. //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2446. procedure TfdABGR_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2447. begin
  2448. inherited Map(aPixel, aData, aMapData);
  2449. PWord(aData)^ := aPixel.Data.a;
  2450. inc(aData, 2);
  2451. end;
  2452. procedure TfdABGR_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2453. begin
  2454. inherited Unmap(aData, aPixel, aMapData);
  2455. aPixel.Data.a := PWord(aData)^;
  2456. inc(aData, 2);
  2457. end;
  2458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2459. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2460. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2461. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2462. var
  2463. i: Integer;
  2464. begin
  2465. PCardinal(aData)^ := 0;
  2466. for i := 0 to 3 do
  2467. if (fRange.arr[i] > 0) then
  2468. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2469. inc(aData, 4);
  2470. end;
  2471. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2472. var
  2473. i: Integer;
  2474. begin
  2475. for i := 0 to 3 do
  2476. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2477. inc(aData, 2);
  2478. end;
  2479. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2480. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2481. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2482. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2483. begin
  2484. PCardinal(aData)^ := DepthWeight(aPixel);
  2485. inc(aData, 4);
  2486. end;
  2487. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2488. begin
  2489. aPixel.Data.r := PCardinal(aData)^;
  2490. aPixel.Data.g := PCardinal(aData)^;
  2491. aPixel.Data.b := PCardinal(aData)^;
  2492. aPixel.Data.a := 0;
  2493. inc(aData, 4);
  2494. end;
  2495. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2496. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2497. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2498. constructor TfdAlpha4.Create;
  2499. begin
  2500. inherited Create;
  2501. fPixelSize := 1.0;
  2502. fFormat := tfAlpha4;
  2503. fWithAlpha := tfAlpha4;
  2504. fOpenGLFormat := tfAlpha4;
  2505. fRange.a := $FF;
  2506. fglFormat := GL_ALPHA;
  2507. fglInternalFormat := GL_ALPHA4;
  2508. fglDataFormat := GL_UNSIGNED_BYTE;
  2509. end;
  2510. constructor TfdAlpha8.Create;
  2511. begin
  2512. inherited Create;
  2513. fPixelSize := 1.0;
  2514. fFormat := tfAlpha8;
  2515. fWithAlpha := tfAlpha8;
  2516. fOpenGLFormat := tfAlpha8;
  2517. fRange.a := $FF;
  2518. fglFormat := GL_ALPHA;
  2519. fglInternalFormat := GL_ALPHA8;
  2520. fglDataFormat := GL_UNSIGNED_BYTE;
  2521. end;
  2522. constructor TfdAlpha16.Create;
  2523. begin
  2524. inherited Create;
  2525. fPixelSize := 2.0;
  2526. fFormat := tfAlpha16;
  2527. fWithAlpha := tfAlpha16;
  2528. fOpenGLFormat := tfAlpha16;
  2529. fRange.a := $FFFF;
  2530. fglFormat := GL_ALPHA;
  2531. fglInternalFormat := GL_ALPHA16;
  2532. fglDataFormat := GL_UNSIGNED_SHORT;
  2533. end;
  2534. constructor TfdLuminance4.Create;
  2535. begin
  2536. inherited Create;
  2537. fPixelSize := 1.0;
  2538. fFormat := tfLuminance4;
  2539. fWithAlpha := tfLuminance4Alpha4;
  2540. fWithoutAlpha := tfLuminance4;
  2541. fOpenGLFormat := tfLuminance4;
  2542. fRange.r := $FF;
  2543. fRange.g := $FF;
  2544. fRange.b := $FF;
  2545. fglFormat := GL_LUMINANCE;
  2546. fglInternalFormat := GL_LUMINANCE4;
  2547. fglDataFormat := GL_UNSIGNED_BYTE;
  2548. end;
  2549. constructor TfdLuminance8.Create;
  2550. begin
  2551. inherited Create;
  2552. fPixelSize := 1.0;
  2553. fFormat := tfLuminance8;
  2554. fWithAlpha := tfLuminance8Alpha8;
  2555. fWithoutAlpha := tfLuminance8;
  2556. fOpenGLFormat := tfLuminance8;
  2557. fRange.r := $FF;
  2558. fRange.g := $FF;
  2559. fRange.b := $FF;
  2560. fglFormat := GL_LUMINANCE;
  2561. fglInternalFormat := GL_LUMINANCE8;
  2562. fglDataFormat := GL_UNSIGNED_BYTE;
  2563. end;
  2564. constructor TfdLuminance16.Create;
  2565. begin
  2566. inherited Create;
  2567. fPixelSize := 2.0;
  2568. fFormat := tfLuminance16;
  2569. fWithAlpha := tfLuminance16Alpha16;
  2570. fWithoutAlpha := tfLuminance16;
  2571. fOpenGLFormat := tfLuminance16;
  2572. fRange.r := $FFFF;
  2573. fRange.g := $FFFF;
  2574. fRange.b := $FFFF;
  2575. fglFormat := GL_LUMINANCE;
  2576. fglInternalFormat := GL_LUMINANCE16;
  2577. fglDataFormat := GL_UNSIGNED_SHORT;
  2578. end;
  2579. constructor TfdLuminance4Alpha4.Create;
  2580. begin
  2581. inherited Create;
  2582. fPixelSize := 2.0;
  2583. fFormat := tfLuminance4Alpha4;
  2584. fWithAlpha := tfLuminance4Alpha4;
  2585. fWithoutAlpha := tfLuminance4;
  2586. fOpenGLFormat := tfLuminance4Alpha4;
  2587. fRange.r := $FF;
  2588. fRange.g := $FF;
  2589. fRange.b := $FF;
  2590. fRange.a := $FF;
  2591. fShift.r := 0;
  2592. fShift.g := 0;
  2593. fShift.b := 0;
  2594. fShift.a := 8;
  2595. fglFormat := GL_LUMINANCE_ALPHA;
  2596. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2597. fglDataFormat := GL_UNSIGNED_BYTE;
  2598. end;
  2599. constructor TfdLuminance6Alpha2.Create;
  2600. begin
  2601. inherited Create;
  2602. fPixelSize := 2.0;
  2603. fFormat := tfLuminance6Alpha2;
  2604. fWithAlpha := tfLuminance6Alpha2;
  2605. fWithoutAlpha := tfLuminance8;
  2606. fOpenGLFormat := tfLuminance6Alpha2;
  2607. fRange.r := $FF;
  2608. fRange.g := $FF;
  2609. fRange.b := $FF;
  2610. fRange.a := $FF;
  2611. fShift.r := 0;
  2612. fShift.g := 0;
  2613. fShift.b := 0;
  2614. fShift.a := 8;
  2615. fglFormat := GL_LUMINANCE_ALPHA;
  2616. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2617. fglDataFormat := GL_UNSIGNED_BYTE;
  2618. end;
  2619. constructor TfdLuminance8Alpha8.Create;
  2620. begin
  2621. inherited Create;
  2622. fPixelSize := 2.0;
  2623. fFormat := tfLuminance8Alpha8;
  2624. fWithAlpha := tfLuminance8Alpha8;
  2625. fWithoutAlpha := tfLuminance8;
  2626. fOpenGLFormat := tfLuminance8Alpha8;
  2627. fRange.r := $FF;
  2628. fRange.g := $FF;
  2629. fRange.b := $FF;
  2630. fRange.a := $FF;
  2631. fShift.r := 0;
  2632. fShift.g := 0;
  2633. fShift.b := 0;
  2634. fShift.a := 8;
  2635. fglFormat := GL_LUMINANCE_ALPHA;
  2636. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2637. fglDataFormat := GL_UNSIGNED_BYTE;
  2638. end;
  2639. constructor TfdLuminance12Alpha4.Create;
  2640. begin
  2641. inherited Create;
  2642. fPixelSize := 4.0;
  2643. fFormat := tfLuminance12Alpha4;
  2644. fWithAlpha := tfLuminance12Alpha4;
  2645. fWithoutAlpha := tfLuminance16;
  2646. fOpenGLFormat := tfLuminance12Alpha4;
  2647. fRange.r := $FFFF;
  2648. fRange.g := $FFFF;
  2649. fRange.b := $FFFF;
  2650. fRange.a := $FFFF;
  2651. fShift.r := 0;
  2652. fShift.g := 0;
  2653. fShift.b := 0;
  2654. fShift.a := 16;
  2655. fglFormat := GL_LUMINANCE_ALPHA;
  2656. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2657. fglDataFormat := GL_UNSIGNED_SHORT;
  2658. end;
  2659. constructor TfdLuminance16Alpha16.Create;
  2660. begin
  2661. inherited Create;
  2662. fPixelSize := 4.0;
  2663. fFormat := tfLuminance16Alpha16;
  2664. fWithAlpha := tfLuminance16Alpha16;
  2665. fWithoutAlpha := tfLuminance16;
  2666. fOpenGLFormat := tfLuminance16Alpha16;
  2667. fRange.r := $FFFF;
  2668. fRange.g := $FFFF;
  2669. fRange.b := $FFFF;
  2670. fRange.a := $FFFF;
  2671. fShift.r := 0;
  2672. fShift.g := 0;
  2673. fShift.b := 0;
  2674. fShift.a := 16;
  2675. fglFormat := GL_LUMINANCE_ALPHA;
  2676. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2677. fglDataFormat := GL_UNSIGNED_SHORT;
  2678. end;
  2679. constructor TfdR3G3B2.Create;
  2680. begin
  2681. inherited Create;
  2682. fPixelSize := 1.0;
  2683. fFormat := tfR3G3B2;
  2684. fWithAlpha := tfRGBA4;
  2685. fWithoutAlpha := tfR3G3B2;
  2686. fOpenGLFormat := tfR3G3B2;
  2687. fRGBInverted := tfEmpty;
  2688. fRange.r := $07;
  2689. fRange.g := $07;
  2690. fRange.b := $04;
  2691. fShift.r := 5;
  2692. fShift.g := 2;
  2693. fShift.b := 0;
  2694. fglFormat := GL_RGB;
  2695. fglInternalFormat := GL_R3_G3_B2;
  2696. fglDataFormat := GL_UNSIGNED_BYTE_3_3_2;
  2697. end;
  2698. constructor TfdRGBX4.Create;
  2699. begin
  2700. inherited Create;
  2701. fPixelSize := 2.0;
  2702. fFormat := tfRGBX4;
  2703. fWithAlpha := tfRGBA4;
  2704. fWithoutAlpha := tfRGBX4;
  2705. fOpenGLFormat := tfRGBX4;
  2706. fRGBInverted := tfBGRX4;
  2707. fRange.r := $0F;
  2708. fRange.g := $0F;
  2709. fRange.b := $0F;
  2710. fRange.a := $00;
  2711. fShift.r := 12;
  2712. fShift.g := 8;
  2713. fShift.b := 4;
  2714. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2715. fglInternalFormat := GL_RGB4;
  2716. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2717. end;
  2718. constructor TfdXRGB4.Create;
  2719. begin
  2720. inherited Create;
  2721. fPixelSize := 2.0;
  2722. fFormat := tfXRGB4;
  2723. fWithAlpha := tfARGB4;
  2724. fWithoutAlpha := tfXRGB4;
  2725. fOpenGLFormat := tfXRGB4;
  2726. fRGBInverted := tfXBGR4;
  2727. fRange.r := $0F;
  2728. fRange.g := $0F;
  2729. fRange.b := $0F;
  2730. fShift.r := 8;
  2731. fShift.g := 4;
  2732. fShift.b := 0;
  2733. fglFormat := GL_BGRA;
  2734. fglInternalFormat := GL_RGB4;
  2735. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2736. end;
  2737. constructor TfdR5G6B5.Create;
  2738. begin
  2739. inherited Create;
  2740. fPixelSize := 2.0;
  2741. fFormat := tfR5G6B5;
  2742. fWithAlpha := tfRGB5A1;
  2743. fWithoutAlpha := tfR5G6B5;
  2744. fOpenGLFormat := tfR5G6B5;
  2745. fRGBInverted := tfB5G6R5;
  2746. fRange.r := $1F;
  2747. fRange.g := $3F;
  2748. fRange.b := $1F;
  2749. fShift.r := 11;
  2750. fShift.g := 5;
  2751. fShift.b := 0;
  2752. fglFormat := GL_RGB;
  2753. fglInternalFormat := GL_RGB565;
  2754. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2755. end;
  2756. constructor TfdRGB5X1.Create;
  2757. begin
  2758. inherited Create;
  2759. fPixelSize := 2.0;
  2760. fFormat := tfRGB5X1;
  2761. fWithAlpha := tfRGB5A1;
  2762. fWithoutAlpha := tfRGB5X1;
  2763. fOpenGLFormat := tfRGB5X1;
  2764. fRGBInverted := tfBGR5X1;
  2765. fRange.r := $1F;
  2766. fRange.g := $1F;
  2767. fRange.b := $1F;
  2768. fShift.r := 11;
  2769. fShift.g := 6;
  2770. fShift.b := 1;
  2771. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2772. fglInternalFormat := GL_RGB5;
  2773. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2774. end;
  2775. constructor TfdX1RGB5.Create;
  2776. begin
  2777. inherited Create;
  2778. fPixelSize := 2.0;
  2779. fFormat := tfX1RGB5;
  2780. fWithAlpha := tfA1RGB5;
  2781. fWithoutAlpha := tfX1RGB5;
  2782. fOpenGLFormat := tfX1RGB5;
  2783. fRGBInverted := tfX1BGR5;
  2784. fRange.r := $1F;
  2785. fRange.g := $1F;
  2786. fRange.b := $1F;
  2787. fShift.r := 10;
  2788. fShift.g := 5;
  2789. fShift.b := 0;
  2790. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2791. fglInternalFormat := GL_RGB5;
  2792. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2793. end;
  2794. constructor TfdRGB8.Create;
  2795. begin
  2796. inherited Create;
  2797. fPixelSize := 3.0;
  2798. fFormat := tfRGB8;
  2799. fWithAlpha := tfRGBA8;
  2800. fWithoutAlpha := tfRGB8;
  2801. fOpenGLFormat := tfRGB8;
  2802. fRGBInverted := tfBGR8;
  2803. fRange.r := $FF;
  2804. fRange.g := $FF;
  2805. fRange.b := $FF;
  2806. fShift.r := 16;
  2807. fShift.g := 8;
  2808. fShift.b := 0;
  2809. fglFormat := GL_BGR; // reverse byte order to match little endianess
  2810. fglInternalFormat := GL_RGB8; // as if u interpret the 3 bytes as unsigned integer
  2811. fglDataFormat := GL_UNSIGNED_BYTE;
  2812. end;
  2813. constructor TfdRGBX8.Create;
  2814. begin
  2815. inherited Create;
  2816. fPixelSize := 4.0;
  2817. fFormat := tfRGBX8;
  2818. fWithAlpha := tfRGBA8;
  2819. fWithoutAlpha := tfRGBX8;
  2820. fOpenGLFormat := tfRGB8;
  2821. fRGBInverted := tfBGRX8;
  2822. fRange.r := $FF;
  2823. fRange.g := $FF;
  2824. fRange.b := $FF;
  2825. fShift.r := 24;
  2826. fShift.g := 16;
  2827. fShift.b := 8;
  2828. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2829. fglInternalFormat := GL_RGB8;
  2830. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2831. end;
  2832. constructor TfdXRGB8.Create;
  2833. begin
  2834. inherited Create;
  2835. fPixelSize := 4.0;
  2836. fFormat := tfXRGB8;
  2837. fWithAlpha := tfXRGB8;
  2838. fWithoutAlpha := tfXRGB8;
  2839. fOpenGLFormat := tfRGB8;
  2840. fRGBInverted := tfXBGR8;
  2841. fRange.r := $FF;
  2842. fRange.g := $FF;
  2843. fRange.b := $FF;
  2844. fShift.r := 16;
  2845. fShift.g := 8;
  2846. fShift.b := 0;
  2847. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2848. fglInternalFormat := GL_RGB8;
  2849. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2850. end;
  2851. constructor TfdRGB10X2.Create;
  2852. begin
  2853. inherited Create;
  2854. fPixelSize := 3.0;
  2855. fFormat := tfRGB10X2;
  2856. fWithAlpha := tfRGB10A2;
  2857. fWithoutAlpha := tfRGB10X2;
  2858. fOpenGLFormat := tfRGB10X2;
  2859. fRGBInverted := tfBGR10X2;
  2860. fRange.r := $03FF;
  2861. fRange.g := $03FF;
  2862. fRange.b := $03FF;
  2863. fShift.r := 22;
  2864. fShift.g := 12;
  2865. fShift.b := 2;
  2866. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2867. fglInternalFormat := GL_RGB10;
  2868. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2869. end;
  2870. constructor TfdX2RGB10.Create;
  2871. begin
  2872. inherited Create;
  2873. fPixelSize := 3.0;
  2874. fFormat := tfX2RGB10;
  2875. fWithAlpha := tfA2RGB10;
  2876. fWithoutAlpha := tfX2RGB10;
  2877. fOpenGLFormat := tfX2RGB10;
  2878. fRGBInverted := tfX2BGR10;
  2879. fRange.r := $03FF;
  2880. fRange.g := $03FF;
  2881. fRange.b := $03FF;
  2882. fShift.r := 20;
  2883. fShift.g := 10;
  2884. fShift.b := 0;
  2885. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2886. fglInternalFormat := GL_RGB10;
  2887. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2888. end;
  2889. constructor TfdRGB16.Create;
  2890. begin
  2891. inherited Create;
  2892. fPixelSize := 6.0;
  2893. fFormat := tfRGB16;
  2894. fWithAlpha := tfRGBA16;
  2895. fWithoutAlpha := tfRGB16;
  2896. fOpenGLFormat := tfRGB16;
  2897. fRGBInverted := tfBGR16;
  2898. fRange.r := $FFFF;
  2899. fRange.g := $FFFF;
  2900. fRange.b := $FFFF;
  2901. fShift.r := 32;
  2902. fShift.g := 16;
  2903. fShift.b := 0;
  2904. fglFormat := GL_BGR; // reverse byte order to match little endianess
  2905. fglInternalFormat := GL_RGB16; // as if u interpret the 3 bytes as unsigned integer
  2906. fglDataFormat := GL_UNSIGNED_SHORT;
  2907. end;
  2908. constructor TfdRGBA4.Create;
  2909. begin
  2910. inherited Create;
  2911. fPixelSize := 2.0;
  2912. fFormat := tfRGBA4;
  2913. fWithAlpha := tfRGBA4;
  2914. fWithoutAlpha := tfRGBX4;
  2915. fOpenGLFormat := tfRGBA4;
  2916. fRGBInverted := tfBGRA4;
  2917. fRange.r := $0F;
  2918. fRange.g := $0F;
  2919. fRange.b := $0F;
  2920. fRange.a := $0F;
  2921. fShift.r := 12;
  2922. fShift.g := 8;
  2923. fShift.b := 4;
  2924. fShift.a := 0;
  2925. fglFormat := GL_RGBA;
  2926. fglInternalFormat := GL_RGBA4;
  2927. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2928. end;
  2929. constructor TfdARGB4.Create;
  2930. begin
  2931. inherited Create;
  2932. fPixelSize := 2.0;
  2933. fFormat := tfARGB4;
  2934. fWithAlpha := tfARGB4;
  2935. fWithoutAlpha := tfXRGB4;
  2936. fOpenGLFormat := tfARGB4;
  2937. fRGBInverted := tfABGR4;
  2938. fRange.r := $0F;
  2939. fRange.g := $0F;
  2940. fRange.b := $0F;
  2941. fRange.a := $0F;
  2942. fShift.r := 8;
  2943. fShift.g := 4;
  2944. fShift.b := 0;
  2945. fShift.a := 12;
  2946. fglFormat := GL_BGRA;
  2947. fglInternalFormat := GL_RGBA4;
  2948. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2949. end;
  2950. constructor TfdRGB5A1.Create;
  2951. begin
  2952. inherited Create;
  2953. fPixelSize := 2.0;
  2954. fFormat := tfRGB5A1;
  2955. fWithAlpha := tfRGB5A1;
  2956. fWithoutAlpha := tfRGB5X1;
  2957. fOpenGLFormat := tfRGB5A1;
  2958. fRGBInverted := tfBGR5A1;
  2959. fRange.r := $1F;
  2960. fRange.g := $1F;
  2961. fRange.b := $1F;
  2962. fRange.a := $01;
  2963. fShift.r := 11;
  2964. fShift.g := 6;
  2965. fShift.b := 1;
  2966. fShift.a := 0;
  2967. fglFormat := GL_RGBA;
  2968. fglInternalFormat := GL_RGB5_A1;
  2969. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2970. end;
  2971. constructor TfdA1RGB5.Create;
  2972. begin
  2973. inherited Create;
  2974. fPixelSize := 2.0;
  2975. fFormat := tfA1RGB5;
  2976. fWithAlpha := tfA1RGB5;
  2977. fWithoutAlpha := tfX1RGB5;
  2978. fOpenGLFormat := tfA1RGB5;
  2979. fRGBInverted := tfA1BGR5;
  2980. fRange.r := $1F;
  2981. fRange.g := $1F;
  2982. fRange.b := $1F;
  2983. fRange.a := $01;
  2984. fShift.r := 10;
  2985. fShift.g := 5;
  2986. fShift.b := 0;
  2987. fShift.a := 15;
  2988. fglFormat := GL_BGRA;
  2989. fglInternalFormat := GL_RGB5_A1;
  2990. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2991. end;
  2992. constructor TfdRGBA8.Create;
  2993. begin
  2994. inherited Create;
  2995. fPixelSize := 4.0;
  2996. fFormat := tfRGBA8;
  2997. fWithAlpha := tfRGBA8;
  2998. fWithoutAlpha := tfRGB8;
  2999. fOpenGLFormat := tfRGBA8;
  3000. fRGBInverted := tfBGRA8;
  3001. fRange.r := $FF;
  3002. fRange.g := $FF;
  3003. fRange.b := $FF;
  3004. fRange.a := $FF;
  3005. fShift.r := 24;
  3006. fShift.g := 16;
  3007. fShift.b := 8;
  3008. fShift.a := 0;
  3009. fglFormat := GL_RGBA;
  3010. fglInternalFormat := GL_RGBA8;
  3011. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3012. end;
  3013. constructor TfdARGB8.Create;
  3014. begin
  3015. inherited Create;
  3016. fPixelSize := 4.0;
  3017. fFormat := tfARGB8;
  3018. fWithAlpha := tfARGB8;
  3019. fWithoutAlpha := tfRGB8;
  3020. fOpenGLFormat := tfARGB8;
  3021. fRGBInverted := tfABGR8;
  3022. fRange.r := $FF;
  3023. fRange.g := $FF;
  3024. fRange.b := $FF;
  3025. fRange.a := $FF;
  3026. fShift.r := 16;
  3027. fShift.g := 8;
  3028. fShift.b := 0;
  3029. fShift.a := 24;
  3030. fglFormat := GL_BGRA;
  3031. fglInternalFormat := GL_RGBA8;
  3032. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3033. end;
  3034. constructor TfdRGB10A2.Create;
  3035. begin
  3036. inherited Create;
  3037. fPixelSize := 3.0;
  3038. fFormat := tfRGB10A2;
  3039. fWithAlpha := tfRGB10A2;
  3040. fWithoutAlpha := tfRGB10X2;
  3041. fOpenGLFormat := tfRGB10A2;
  3042. fRGBInverted := tfBGR10A2;
  3043. fRange.r := $03FF;
  3044. fRange.g := $03FF;
  3045. fRange.b := $03FF;
  3046. fRange.a := $0003;
  3047. fShift.r := 22;
  3048. fShift.g := 12;
  3049. fShift.b := 2;
  3050. fShift.a := 0;
  3051. fglFormat := GL_RGBA;
  3052. fglInternalFormat := GL_RGB10_A2;
  3053. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3054. end;
  3055. constructor TfdA2RGB10.Create;
  3056. begin
  3057. inherited Create;
  3058. fPixelSize := 3.0;
  3059. fFormat := tfA2RGB10;
  3060. fWithAlpha := tfA2RGB10;
  3061. fWithoutAlpha := tfX2RGB10;
  3062. fOpenGLFormat := tfA2RGB10;
  3063. fRGBInverted := tfA2BGR10;
  3064. fRange.r := $03FF;
  3065. fRange.g := $03FF;
  3066. fRange.b := $03FF;
  3067. fRange.a := $0003;
  3068. fShift.r := 20;
  3069. fShift.g := 10;
  3070. fShift.b := 0;
  3071. fShift.a := 30;
  3072. fglFormat := GL_BGRA;
  3073. fglInternalFormat := GL_RGB10_A2;
  3074. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3075. end;
  3076. constructor TfdRGBA16.Create;
  3077. begin
  3078. inherited Create;
  3079. fPixelSize := 8.0;
  3080. fFormat := tfRGBA16;
  3081. fWithAlpha := tfRGBA16;
  3082. fWithoutAlpha := tfRGB16;
  3083. fOpenGLFormat := tfRGBA16;
  3084. fRGBInverted := tfBGRA16;
  3085. fRange.r := $FFFF;
  3086. fRange.g := $FFFF;
  3087. fRange.b := $FFFF;
  3088. fRange.a := $FFFF;
  3089. fShift.r := 48;
  3090. fShift.g := 32;
  3091. fShift.b := 16;
  3092. fShift.a := 0;
  3093. fglFormat := GL_BGRA; // reverse byte order to match little endianess
  3094. fglInternalFormat := GL_RGBA16; // as if u interpret the 3 bytes as unsigned integer
  3095. fglDataFormat := GL_UNSIGNED_SHORT;
  3096. end;
  3097. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3098. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3099. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3100. constructor TfdBGRX4.Create;
  3101. begin
  3102. inherited Create;
  3103. fPixelSize := 2.0;
  3104. fFormat := tfBGRX4;
  3105. fWithAlpha := tfBGRA4;
  3106. fWithoutAlpha := tfBGRX4;
  3107. fOpenGLFormat := tfBGRX4;
  3108. fRGBInverted := tfRGBX4;
  3109. fRange.r := $0F;
  3110. fRange.g := $0F;
  3111. fRange.b := $0F;
  3112. fShift.r := 4;
  3113. fShift.g := 8;
  3114. fShift.b := 12;
  3115. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3116. fglInternalFormat := GL_RGB4;
  3117. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3118. end;
  3119. constructor TfdXBGR4.Create;
  3120. begin
  3121. inherited Create;
  3122. fPixelSize := 2.0;
  3123. fFormat := tfXBGR4;
  3124. fWithAlpha := tfABGR4;
  3125. fWithoutAlpha := tfXBGR4;
  3126. fOpenGLFormat := tfXBGR4;
  3127. fRGBInverted := tfXRGB4;
  3128. fRange.r := $0F;
  3129. fRange.g := $0F;
  3130. fRange.b := $0F;
  3131. fRange.a := $0F;
  3132. fShift.r := 0;
  3133. fShift.g := 4;
  3134. fShift.b := 8;
  3135. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3136. fglInternalFormat := GL_RGB4;
  3137. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3138. end;
  3139. constructor TfdB5G6R5.Create;
  3140. begin
  3141. inherited Create;
  3142. fPixelSize := 2.0;
  3143. fFormat := tfB5G6R5;
  3144. fWithAlpha := tfBGR5A1;
  3145. fWithoutAlpha := tfB5G6R5;
  3146. fOpenGLFormat := tfB5G6R5;
  3147. fRGBInverted := tfR5G6B5;
  3148. fRange.r := $1F;
  3149. fRange.g := $3F;
  3150. fRange.b := $1F;
  3151. fShift.r := 0;
  3152. fShift.g := 5;
  3153. fShift.b := 11;
  3154. fglFormat := GL_RGB;
  3155. fglInternalFormat := GL_RGB565;
  3156. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  3157. end;
  3158. constructor TfdBGR5X1.Create;
  3159. begin
  3160. inherited Create;
  3161. fPixelSize := 2.0;
  3162. fFormat := tfBGR5X1;
  3163. fWithAlpha := tfBGR5A1;
  3164. fWithoutAlpha := tfBGR5X1;
  3165. fOpenGLFormat := tfBGR5X1;
  3166. fRGBInverted := tfRGB5X1;
  3167. fRange.r := $1F;
  3168. fRange.g := $1F;
  3169. fRange.b := $1F;
  3170. fShift.r := 1;
  3171. fShift.g := 6;
  3172. fShift.b := 11;
  3173. fglFormat := GL_BGRA;
  3174. fglInternalFormat := GL_RGB5;
  3175. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3176. end;
  3177. constructor TfdX1BGR5.Create;
  3178. begin
  3179. inherited Create;
  3180. fPixelSize := 2.0;
  3181. fFormat := tfX1BGR5;
  3182. fWithAlpha := tfA1BGR5;
  3183. fWithoutAlpha := tfX1BGR5;
  3184. fOpenGLFormat := tfX1BGR5;
  3185. fRGBInverted := tfX1RGB5;
  3186. fRange.r := $1F;
  3187. fRange.g := $1F;
  3188. fRange.b := $1F;
  3189. fShift.r := 0;
  3190. fShift.g := 5;
  3191. fShift.b := 10;
  3192. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3193. fglInternalFormat := GL_RGB5;
  3194. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3195. end;
  3196. constructor TfdBGR8.Create;
  3197. begin
  3198. inherited Create;
  3199. fPixelSize := 3.0;
  3200. fFormat := tfBGR8;
  3201. fWithAlpha := tfBGRA8;
  3202. fWithoutAlpha := tfBGR8;
  3203. fOpenGLFormat := tfBGR8;
  3204. fRGBInverted := tfRGB8;
  3205. fRange.r := $FF;
  3206. fRange.g := $FF;
  3207. fRange.b := $FF;
  3208. fShift.r := 0;
  3209. fShift.g := 8;
  3210. fShift.b := 16;
  3211. fglFormat := GL_RGB; // reverse byte order to match little endianess
  3212. fglInternalFormat := GL_RGB8; // as if u interpret the 3 bytes as unsigned integer
  3213. fglDataFormat := GL_UNSIGNED_BYTE;
  3214. end;
  3215. constructor TfdBGRX8.Create;
  3216. begin
  3217. inherited Create;
  3218. fPixelSize := 4.0;
  3219. fFormat := tfBGRX8;
  3220. fWithAlpha := tfBGRA8;
  3221. fWithoutAlpha := tfBGRX8;
  3222. fOpenGLFormat := tfBGRX8;
  3223. fRGBInverted := tfRGBX8;
  3224. fRange.r := $FF;
  3225. fRange.g := $FF;
  3226. fRange.b := $FF;
  3227. fShift.r := 8;
  3228. fShift.g := 16;
  3229. fShift.b := 24;
  3230. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3231. fglInternalFormat := GL_RGB8;
  3232. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3233. end;
  3234. constructor TfdXBGR8.Create;
  3235. begin
  3236. inherited Create;
  3237. fPixelSize := 4.0;
  3238. fFormat := tfXBGR8;
  3239. fWithAlpha := tfABGR8;
  3240. fWithoutAlpha := tfXBGR8;
  3241. fOpenGLFormat := tfXBGR8;
  3242. fRGBInverted := tfXRGB8;
  3243. fRange.r := $FF;
  3244. fRange.g := $FF;
  3245. fRange.b := $FF;
  3246. fShift.r := 0;
  3247. fShift.g := 8;
  3248. fShift.b := 16;
  3249. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3250. fglInternalFormat := GL_RGB8;
  3251. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3252. end;
  3253. constructor TfdBGR10X2.Create;
  3254. begin
  3255. inherited Create;
  3256. fPixelSize := 3.0;
  3257. fFormat := tfBGR10X2;
  3258. fWithAlpha := tfBGR10A2;
  3259. fWithoutAlpha := tfBGR10X2;
  3260. fOpenGLFormat := tfBGR10X2;
  3261. fRGBInverted := tfRGB10X2;
  3262. fRange.r := $03FF;
  3263. fRange.g := $03FF;
  3264. fRange.b := $03FF;
  3265. fShift.r := 2;
  3266. fShift.g := 12;
  3267. fShift.b := 22;
  3268. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3269. fglInternalFormat := GL_RGB10;
  3270. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3271. end;
  3272. constructor TfdX2BGR10.Create;
  3273. begin
  3274. inherited Create;
  3275. fPixelSize := 3.0;
  3276. fFormat := tfX2BGR10;
  3277. fWithAlpha := tfA2BGR10;
  3278. fWithoutAlpha := tfX2BGR10;
  3279. fOpenGLFormat := tfX2BGR10;
  3280. fRGBInverted := tfX2RGB10;
  3281. fRange.r := $03FF;
  3282. fRange.g := $03FF;
  3283. fRange.b := $03FF;
  3284. fShift.r := 0;
  3285. fShift.g := 10;
  3286. fShift.b := 20;
  3287. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3288. fglInternalFormat := GL_RGB10;
  3289. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3290. end;
  3291. constructor TfdBGR16.Create;
  3292. begin
  3293. inherited Create;
  3294. fPixelSize := 6.0;
  3295. fFormat := tfBGR16;
  3296. fWithAlpha := tfBGRA16;
  3297. fWithoutAlpha := tfBGR16;
  3298. fOpenGLFormat := tfBGR16;
  3299. fRGBInverted := tfRGB16;
  3300. fRange.r := $FFFF;
  3301. fRange.g := $FFFF;
  3302. fRange.b := $FFFF;
  3303. fShift.r := 0;
  3304. fShift.g := 16;
  3305. fShift.b := 32;
  3306. fglFormat := GL_RGB; // reverse byte order to match little endianess
  3307. fglInternalFormat := GL_RGB16; // as if u interpret the 3 bytes as unsigned integer
  3308. fglDataFormat := GL_UNSIGNED_SHORT;
  3309. end;
  3310. constructor TfdBGRA4.Create;
  3311. begin
  3312. inherited Create;
  3313. fPixelSize := 2.0;
  3314. fFormat := tfBGRA4;
  3315. fWithAlpha := tfBGRA4;
  3316. fWithoutAlpha := tfBGRX4;
  3317. fOpenGLFormat := tfBGRA4;
  3318. fRGBInverted := tfRGBA4;
  3319. fRange.r := $0F;
  3320. fRange.g := $0F;
  3321. fRange.b := $0F;
  3322. fRange.a := $0F;
  3323. fShift.r := 4;
  3324. fShift.g := 8;
  3325. fShift.b := 12;
  3326. fShift.a := 0;
  3327. fglFormat := GL_BGRA;
  3328. fglInternalFormat := GL_RGBA4;
  3329. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3330. end;
  3331. constructor TfdABGR4.Create;
  3332. begin
  3333. inherited Create;
  3334. fPixelSize := 2.0;
  3335. fFormat := tfABGR4;
  3336. fWithAlpha := tfABGR4;
  3337. fWithoutAlpha := tfXBGR4;
  3338. fOpenGLFormat := tfABGR4;
  3339. fRGBInverted := tfARGB4;
  3340. fRange.r := $0F;
  3341. fRange.g := $0F;
  3342. fRange.b := $0F;
  3343. fRange.a := $0F;
  3344. fShift.r := 0;
  3345. fShift.g := 4;
  3346. fShift.b := 8;
  3347. fShift.a := 12;
  3348. fglFormat := GL_RGBA;
  3349. fglInternalFormat := GL_RGBA4;
  3350. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3351. end;
  3352. constructor TfdBGR5A1.Create;
  3353. begin
  3354. inherited Create;
  3355. fPixelSize := 2.0;
  3356. fFormat := tfBGR5A1;
  3357. fWithAlpha := tfBGR5A1;
  3358. fWithoutAlpha := tfBGR5X1;
  3359. fOpenGLFormat := tfBGR5A1;
  3360. fRGBInverted := tfRGB5A1;
  3361. fRange.r := $1F;
  3362. fRange.g := $1F;
  3363. fRange.b := $1F;
  3364. fRange.a := $01;
  3365. fShift.r := 1;
  3366. fShift.g := 6;
  3367. fShift.b := 11;
  3368. fShift.a := 0;
  3369. fglFormat := GL_BGRA;
  3370. fglInternalFormat := GL_RGB5_A1;
  3371. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3372. end;
  3373. constructor TfdA1BGR5.Create;
  3374. begin
  3375. inherited Create;
  3376. fPixelSize := 2.0;
  3377. fFormat := tfA1BGR5;
  3378. fWithAlpha := tfA1BGR5;
  3379. fWithoutAlpha := tfX1BGR5;
  3380. fOpenGLFormat := tfA1BGR5;
  3381. fRGBInverted := tfA1RGB5;
  3382. fRange.r := $1F;
  3383. fRange.g := $1F;
  3384. fRange.b := $1F;
  3385. fRange.a := $01;
  3386. fShift.r := 0;
  3387. fShift.g := 5;
  3388. fShift.b := 10;
  3389. fShift.a := 15;
  3390. fglFormat := GL_RGBA;
  3391. fglInternalFormat := GL_RGB5_A1;
  3392. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3393. end;
  3394. constructor TfdBGRA8.Create;
  3395. begin
  3396. inherited Create;
  3397. fPixelSize := 4.0;
  3398. fFormat := tfBGRA8;
  3399. fWithAlpha := tfBGRA8;
  3400. fWithoutAlpha := tfBGR8;
  3401. fOpenGLFormat := tfBGRA8;
  3402. fRGBInverted := tfRGBA8;
  3403. fRange.r := $FF;
  3404. fRange.g := $FF;
  3405. fRange.b := $FF;
  3406. fRange.a := $FF;
  3407. fShift.r := 8;
  3408. fShift.g := 16;
  3409. fShift.b := 24;
  3410. fShift.a := 0;
  3411. fglFormat := GL_BGRA;
  3412. fglInternalFormat := GL_RGBA8;
  3413. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3414. end;
  3415. constructor TfdABGR8.Create;
  3416. begin
  3417. inherited Create;
  3418. fPixelSize := 4.0;
  3419. fFormat := tfABGR8;
  3420. fWithAlpha := tfABGR8;
  3421. fWithoutAlpha := tfBGR8;
  3422. fOpenGLFormat := tfABGR8;
  3423. fRGBInverted := tfARGB8;
  3424. fRange.r := $FF;
  3425. fRange.g := $FF;
  3426. fRange.b := $FF;
  3427. fRange.a := $FF;
  3428. fShift.r := 0;
  3429. fShift.g := 8;
  3430. fShift.b := 16;
  3431. fShift.a := 24;
  3432. fglFormat := GL_RGBA;
  3433. fglInternalFormat := GL_RGBA8;
  3434. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3435. end;
  3436. constructor TfdBGR10A2.Create;
  3437. begin
  3438. inherited Create;
  3439. fPixelSize := 3.0;
  3440. fFormat := tfBGR10A2;
  3441. fWithAlpha := tfBGR10A2;
  3442. fWithoutAlpha := tfBGR10X2;
  3443. fOpenGLFormat := tfBGR10A2;
  3444. fRGBInverted := tfRGB10A2;
  3445. fRange.r := $03FF;
  3446. fRange.g := $03FF;
  3447. fRange.b := $03FF;
  3448. fRange.a := $0003;
  3449. fShift.r := 2;
  3450. fShift.g := 12;
  3451. fShift.b := 22;
  3452. fShift.a := 0;
  3453. fglFormat := GL_BGRA;
  3454. fglInternalFormat := GL_RGB10_A2;
  3455. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3456. end;
  3457. constructor TfdA2BGR10.Create;
  3458. begin
  3459. inherited Create;
  3460. fPixelSize := 3.0;
  3461. fFormat := tfA2BGR10;
  3462. fWithAlpha := tfA2BGR10;
  3463. fWithoutAlpha := tfX2BGR10;
  3464. fOpenGLFormat := tfA2BGR10;
  3465. fRGBInverted := tfA2RGB10;
  3466. fRange.r := $03FF;
  3467. fRange.g := $03FF;
  3468. fRange.b := $03FF;
  3469. fRange.a := $0003;
  3470. fShift.r := 0;
  3471. fShift.g := 10;
  3472. fShift.b := 20;
  3473. fShift.a := 30;
  3474. fglFormat := GL_RGBA;
  3475. fglInternalFormat := GL_RGB10_A2;
  3476. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3477. end;
  3478. constructor TfdBGRA16.Create;
  3479. begin
  3480. inherited Create;
  3481. fPixelSize := 8.0;
  3482. fFormat := tfBGRA16;
  3483. fWithAlpha := tfBGRA16;
  3484. fWithoutAlpha := tfBGR16;
  3485. fOpenGLFormat := tfBGRA16;
  3486. fRGBInverted := tfRGBA16;
  3487. fRange.r := $FFFF;
  3488. fRange.g := $FFFF;
  3489. fRange.b := $FFFF;
  3490. fRange.a := $FFFF;
  3491. fShift.r := 16;
  3492. fShift.g := 32;
  3493. fShift.b := 48;
  3494. fShift.a := 0;
  3495. fglFormat := GL_RGBA; // reverse byte order to match little endianess
  3496. fglInternalFormat := GL_RGBA16; // as if u interpret the 3 bytes as unsigned integer
  3497. fglDataFormat := GL_UNSIGNED_SHORT;
  3498. end;
  3499. constructor TfdDepth16.Create;
  3500. begin
  3501. inherited Create;
  3502. fPixelSize := 2.0;
  3503. fFormat := tfDepth16;
  3504. fWithoutAlpha := tfDepth16;
  3505. fOpenGLFormat := tfDepth16;
  3506. fRange.r := $FFFF;
  3507. fRange.g := $FFFF;
  3508. fRange.b := $FFFF;
  3509. fRange.a := $FFFF;
  3510. fglFormat := GL_DEPTH_COMPONENT;
  3511. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3512. fglDataFormat := GL_UNSIGNED_SHORT;
  3513. end;
  3514. constructor TfdDepth24.Create;
  3515. begin
  3516. inherited Create;
  3517. fPixelSize := 3.0;
  3518. fFormat := tfDepth24;
  3519. fWithoutAlpha := tfDepth24;
  3520. fOpenGLFormat := tfDepth24;
  3521. fRange.r := $FFFFFF;
  3522. fRange.g := $FFFFFF;
  3523. fRange.b := $FFFFFF;
  3524. fRange.a := $FFFFFF;
  3525. fglFormat := GL_DEPTH_COMPONENT;
  3526. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3527. fglDataFormat := GL_UNSIGNED_INT;
  3528. end;
  3529. constructor TfdDepth32.Create;
  3530. begin
  3531. inherited Create;
  3532. fPixelSize := 4.0;
  3533. fFormat := tfDepth32;
  3534. fWithoutAlpha := tfDepth32;
  3535. fOpenGLFormat := tfDepth32;
  3536. fRange.r := $FFFFFFFF;
  3537. fRange.g := $FFFFFFFF;
  3538. fRange.b := $FFFFFFFF;
  3539. fRange.a := $FFFFFFFF;
  3540. fglFormat := GL_DEPTH_COMPONENT;
  3541. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3542. fglDataFormat := GL_UNSIGNED_INT;
  3543. end;
  3544. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3545. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3546. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3547. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3548. begin
  3549. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3550. end;
  3551. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3552. begin
  3553. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3554. end;
  3555. constructor TfdS3tcDtx1RGBA.Create;
  3556. begin
  3557. inherited Create;
  3558. fFormat := tfS3tcDtx1RGBA;
  3559. fWithAlpha := tfS3tcDtx1RGBA;
  3560. fOpenGLFormat := tfS3tcDtx1RGBA;
  3561. fUncompressed := tfRGB5A1;
  3562. fPixelSize := 0.5;
  3563. fIsCompressed := true;
  3564. fglFormat := GL_COMPRESSED_RGBA;
  3565. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3566. fglDataFormat := GL_UNSIGNED_BYTE;
  3567. end;
  3568. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3569. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3570. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3571. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3572. begin
  3573. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3574. end;
  3575. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3576. begin
  3577. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3578. end;
  3579. constructor TfdS3tcDtx3RGBA.Create;
  3580. begin
  3581. inherited Create;
  3582. fFormat := tfS3tcDtx3RGBA;
  3583. fWithAlpha := tfS3tcDtx3RGBA;
  3584. fOpenGLFormat := tfS3tcDtx3RGBA;
  3585. fUncompressed := tfRGBA8;
  3586. fPixelSize := 1.0;
  3587. fIsCompressed := true;
  3588. fglFormat := GL_COMPRESSED_RGBA;
  3589. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3590. fglDataFormat := GL_UNSIGNED_BYTE;
  3591. end;
  3592. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3593. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3595. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3596. begin
  3597. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3598. end;
  3599. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3600. begin
  3601. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3602. end;
  3603. constructor TfdS3tcDtx5RGBA.Create;
  3604. begin
  3605. inherited Create;
  3606. fFormat := tfS3tcDtx3RGBA;
  3607. fWithAlpha := tfS3tcDtx3RGBA;
  3608. fOpenGLFormat := tfS3tcDtx3RGBA;
  3609. fUncompressed := tfRGBA8;
  3610. fPixelSize := 1.0;
  3611. fIsCompressed := true;
  3612. fglFormat := GL_COMPRESSED_RGBA;
  3613. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3614. fglDataFormat := GL_UNSIGNED_BYTE;
  3615. end;
  3616. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3617. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3618. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3619. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3620. var
  3621. f: TglBitmapFormat;
  3622. begin
  3623. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3624. result := TFormatDescriptor.Get(f);
  3625. if (result.glInternalFormat = aInternalFormat) then
  3626. exit;
  3627. end;
  3628. result := TFormatDescriptor.Get(tfEmpty);
  3629. end;
  3630. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3631. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3632. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3633. class procedure TFormatDescriptor.Init;
  3634. begin
  3635. if not Assigned(FormatDescriptorCS) then
  3636. FormatDescriptorCS := TCriticalSection.Create;
  3637. end;
  3638. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3639. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3640. begin
  3641. FormatDescriptorCS.Enter;
  3642. try
  3643. result := FormatDescriptors[aFormat];
  3644. if not Assigned(result) then begin
  3645. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3646. FormatDescriptors[aFormat] := result;
  3647. end;
  3648. finally
  3649. FormatDescriptorCS.Leave;
  3650. end;
  3651. end;
  3652. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3653. class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3654. begin
  3655. result := Get(Get(aFormat).WithAlpha);
  3656. end;
  3657. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3658. class procedure TFormatDescriptor.Clear;
  3659. var
  3660. f: TglBitmapFormat;
  3661. begin
  3662. FormatDescriptorCS.Enter;
  3663. try
  3664. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3665. FreeAndNil(FormatDescriptors[f]);
  3666. finally
  3667. FormatDescriptorCS.Leave;
  3668. end;
  3669. end;
  3670. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3671. class procedure TFormatDescriptor.Finalize;
  3672. begin
  3673. Clear;
  3674. FreeAndNil(FormatDescriptorCS);
  3675. end;
  3676. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3677. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3679. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3680. begin
  3681. Update(aValue, fRange.r, fShift.r);
  3682. end;
  3683. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3684. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3685. begin
  3686. Update(aValue, fRange.g, fShift.g);
  3687. end;
  3688. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3689. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3690. begin
  3691. Update(aValue, fRange.b, fShift.b);
  3692. end;
  3693. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3694. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3695. begin
  3696. Update(aValue, fRange.a, fShift.a);
  3697. end;
  3698. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3699. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3700. aShift: Byte);
  3701. begin
  3702. aShift := 0;
  3703. aRange := 0;
  3704. if (aMask = 0) then
  3705. exit;
  3706. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3707. inc(aShift);
  3708. aMask := aMask shr 1;
  3709. end;
  3710. aRange := 1;
  3711. while (aMask > 0) do begin
  3712. aRange := aRange shl 1;
  3713. aMask := aMask shr 1;
  3714. end;
  3715. dec(aRange);
  3716. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3717. end;
  3718. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3719. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3720. var
  3721. data: QWord;
  3722. s: Integer;
  3723. begin
  3724. data :=
  3725. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3726. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3727. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3728. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3729. s := Round(fPixelSize);
  3730. case s of
  3731. 1: aData^ := data;
  3732. 2: PWord(aData)^ := data;
  3733. 4: PCardinal(aData)^ := data;
  3734. 8: PQWord(aData)^ := data;
  3735. else
  3736. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3737. end;
  3738. inc(aData, s);
  3739. end;
  3740. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3741. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3742. var
  3743. data: QWord;
  3744. s, i: Integer;
  3745. begin
  3746. s := Round(fPixelSize);
  3747. case s of
  3748. 1: data := aData^;
  3749. 2: data := PWord(aData)^;
  3750. 4: data := PCardinal(aData)^;
  3751. 8: data := PQWord(aData)^;
  3752. else
  3753. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3754. end;
  3755. for i := 0 to 3 do
  3756. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3757. inc(aData, s);
  3758. end;
  3759. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3760. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3761. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3762. procedure TbmpColorTableFormat.CreateColorTable;
  3763. var
  3764. i: Integer;
  3765. begin
  3766. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3767. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3768. if (Format = tfLuminance4) then
  3769. SetLength(fColorTable, 16)
  3770. else
  3771. SetLength(fColorTable, 256);
  3772. case Format of
  3773. tfLuminance4: begin
  3774. for i := 0 to High(fColorTable) do begin
  3775. fColorTable[i].r := 16 * i;
  3776. fColorTable[i].g := 16 * i;
  3777. fColorTable[i].b := 16 * i;
  3778. fColorTable[i].a := 0;
  3779. end;
  3780. end;
  3781. tfLuminance8: begin
  3782. for i := 0 to High(fColorTable) do begin
  3783. fColorTable[i].r := i;
  3784. fColorTable[i].g := i;
  3785. fColorTable[i].b := i;
  3786. fColorTable[i].a := 0;
  3787. end;
  3788. end;
  3789. tfR3G3B2: begin
  3790. for i := 0 to High(fColorTable) do begin
  3791. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3792. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3793. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3794. fColorTable[i].a := 0;
  3795. end;
  3796. end;
  3797. end;
  3798. end;
  3799. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3800. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3801. var
  3802. d: Byte;
  3803. begin
  3804. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3805. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3806. case Format of
  3807. tfLuminance4: begin
  3808. if (aMapData = nil) then
  3809. aData^ := 0;
  3810. d := LuminanceWeight(aPixel) and Range.r;
  3811. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3812. inc(PByte(aMapData), 4);
  3813. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3814. inc(aData);
  3815. aMapData := nil;
  3816. end;
  3817. end;
  3818. tfLuminance8: begin
  3819. aData^ := LuminanceWeight(aPixel) and Range.r;
  3820. inc(aData);
  3821. end;
  3822. tfR3G3B2: begin
  3823. aData^ := Round(
  3824. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3825. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3826. ((aPixel.Data.b and Range.b) shl Shift.b));
  3827. inc(aData);
  3828. end;
  3829. end;
  3830. end;
  3831. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3832. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3833. var
  3834. idx: QWord;
  3835. s: Integer;
  3836. bits: Byte;
  3837. f: Single;
  3838. begin
  3839. s := Trunc(fPixelSize);
  3840. f := fPixelSize - s;
  3841. bits := Round(8 * f);
  3842. case s of
  3843. 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
  3844. 1: idx := aData^;
  3845. 2: idx := PWord(aData)^;
  3846. 4: idx := PCardinal(aData)^;
  3847. 8: idx := PQWord(aData)^;
  3848. else
  3849. raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3850. end;
  3851. if (idx >= Length(fColorTable)) then
  3852. raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
  3853. with fColorTable[idx] do begin
  3854. aPixel.Data.r := r;
  3855. aPixel.Data.g := g;
  3856. aPixel.Data.b := b;
  3857. aPixel.Data.a := a;
  3858. end;
  3859. inc(PByte(aMapData), bits);
  3860. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3861. inc(aData, 1);
  3862. dec(PByte(aMapData), 8);
  3863. end;
  3864. inc(aData, s);
  3865. end;
  3866. destructor TbmpColorTableFormat.Destroy;
  3867. begin
  3868. SetLength(fColorTable, 0);
  3869. inherited Destroy;
  3870. end;
  3871. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3872. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3873. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3874. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3875. var
  3876. i: Integer;
  3877. begin
  3878. for i := 0 to 3 do begin
  3879. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3880. if (aSourceFD.Range.arr[i] > 0) then
  3881. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3882. else
  3883. aPixel.Data.arr[i] := 0;
  3884. end;
  3885. end;
  3886. end;
  3887. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3888. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3889. begin
  3890. with aFuncRec do begin
  3891. if (Source.Range.r > 0) then
  3892. Dest.Data.r := Source.Data.r;
  3893. if (Source.Range.g > 0) then
  3894. Dest.Data.g := Source.Data.g;
  3895. if (Source.Range.b > 0) then
  3896. Dest.Data.b := Source.Data.b;
  3897. if (Source.Range.a > 0) then
  3898. Dest.Data.a := Source.Data.a;
  3899. end;
  3900. end;
  3901. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3902. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3903. var
  3904. i: Integer;
  3905. begin
  3906. with aFuncRec do begin
  3907. for i := 0 to 3 do
  3908. if (Source.Range.arr[i] > 0) then
  3909. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3910. end;
  3911. end;
  3912. type
  3913. TShiftData = packed record
  3914. case Integer of
  3915. 0: (r, g, b, a: SmallInt);
  3916. 1: (arr: array[0..3] of SmallInt);
  3917. end;
  3918. PShiftData = ^TShiftData;
  3919. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3920. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3921. var
  3922. i: Integer;
  3923. begin
  3924. with aFuncRec do
  3925. for i := 0 to 3 do
  3926. if (Source.Range.arr[i] > 0) then
  3927. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3928. end;
  3929. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3930. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3931. begin
  3932. with aFuncRec do begin
  3933. Dest.Data := Source.Data;
  3934. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3935. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3936. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3937. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3938. end;
  3939. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3940. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3941. end;
  3942. end;
  3943. end;
  3944. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3945. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3946. var
  3947. i: Integer;
  3948. begin
  3949. with aFuncRec do begin
  3950. for i := 0 to 3 do
  3951. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3952. end;
  3953. end;
  3954. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3955. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3956. var
  3957. Temp: Single;
  3958. begin
  3959. with FuncRec do begin
  3960. if (FuncRec.Args = nil) then begin //source has no alpha
  3961. Temp :=
  3962. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3963. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3964. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3965. Dest.Data.a := Round(Dest.Range.a * Temp);
  3966. end else
  3967. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3968. end;
  3969. end;
  3970. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3971. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3972. type
  3973. PglBitmapPixelData = ^TglBitmapPixelData;
  3974. begin
  3975. with FuncRec do begin
  3976. Dest.Data.r := Source.Data.r;
  3977. Dest.Data.g := Source.Data.g;
  3978. Dest.Data.b := Source.Data.b;
  3979. with PglBitmapPixelData(Args)^ do
  3980. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3981. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3982. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3983. Dest.Data.a := 0
  3984. else
  3985. Dest.Data.a := Dest.Range.a;
  3986. end;
  3987. end;
  3988. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3989. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3990. begin
  3991. with FuncRec do begin
  3992. Dest.Data.r := Source.Data.r;
  3993. Dest.Data.g := Source.Data.g;
  3994. Dest.Data.b := Source.Data.b;
  3995. Dest.Data.a := PCardinal(Args)^;
  3996. end;
  3997. end;
  3998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3999. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  4000. type
  4001. PRGBPix = ^TRGBPix;
  4002. TRGBPix = array [0..2] of byte;
  4003. var
  4004. Temp: Byte;
  4005. begin
  4006. while aWidth > 0 do begin
  4007. Temp := PRGBPix(aData)^[0];
  4008. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  4009. PRGBPix(aData)^[2] := Temp;
  4010. if aHasAlpha then
  4011. Inc(aData, 4)
  4012. else
  4013. Inc(aData, 3);
  4014. dec(aWidth);
  4015. end;
  4016. end;
  4017. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4018. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4019. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4020. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  4021. begin
  4022. result := TFormatDescriptor.Get(Format);
  4023. end;
  4024. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4025. function TglBitmap.GetWidth: Integer;
  4026. begin
  4027. if (ffX in fDimension.Fields) then
  4028. result := fDimension.X
  4029. else
  4030. result := -1;
  4031. end;
  4032. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4033. function TglBitmap.GetHeight: Integer;
  4034. begin
  4035. if (ffY in fDimension.Fields) then
  4036. result := fDimension.Y
  4037. else
  4038. result := -1;
  4039. end;
  4040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4041. function TglBitmap.GetFileWidth: Integer;
  4042. begin
  4043. result := Max(1, Width);
  4044. end;
  4045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4046. function TglBitmap.GetFileHeight: Integer;
  4047. begin
  4048. result := Max(1, Height);
  4049. end;
  4050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4051. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  4052. begin
  4053. if fCustomData = aValue then
  4054. exit;
  4055. fCustomData := aValue;
  4056. end;
  4057. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4058. procedure TglBitmap.SetCustomName(const aValue: String);
  4059. begin
  4060. if fCustomName = aValue then
  4061. exit;
  4062. fCustomName := aValue;
  4063. end;
  4064. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4065. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  4066. begin
  4067. if fCustomNameW = aValue then
  4068. exit;
  4069. fCustomNameW := aValue;
  4070. end;
  4071. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4072. procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
  4073. begin
  4074. if fFreeDataOnDestroy = aValue then
  4075. exit;
  4076. fFreeDataOnDestroy := aValue;
  4077. end;
  4078. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4079. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  4080. begin
  4081. if fDeleteTextureOnFree = aValue then
  4082. exit;
  4083. fDeleteTextureOnFree := aValue;
  4084. end;
  4085. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4086. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  4087. begin
  4088. if fFormat = aValue then
  4089. exit;
  4090. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  4091. raise EglBitmapUnsupportedFormat.Create(Format);
  4092. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  4093. end;
  4094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4095. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  4096. begin
  4097. if fFreeDataAfterGenTexture = aValue then
  4098. exit;
  4099. fFreeDataAfterGenTexture := aValue;
  4100. end;
  4101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4102. procedure TglBitmap.SetID(const aValue: Cardinal);
  4103. begin
  4104. if fID = aValue then
  4105. exit;
  4106. fID := aValue;
  4107. end;
  4108. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4109. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  4110. begin
  4111. if fMipMap = aValue then
  4112. exit;
  4113. fMipMap := aValue;
  4114. end;
  4115. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4116. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  4117. begin
  4118. if fTarget = aValue then
  4119. exit;
  4120. fTarget := aValue;
  4121. end;
  4122. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4123. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  4124. var
  4125. MaxAnisotropic: Integer;
  4126. begin
  4127. fAnisotropic := aValue;
  4128. if (ID > 0) then begin
  4129. if GL_EXT_texture_filter_anisotropic then begin
  4130. if fAnisotropic > 0 then begin
  4131. Bind(false);
  4132. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  4133. if aValue > MaxAnisotropic then
  4134. fAnisotropic := MaxAnisotropic;
  4135. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  4136. end;
  4137. end else begin
  4138. fAnisotropic := 0;
  4139. end;
  4140. end;
  4141. end;
  4142. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4143. procedure TglBitmap.CreateID;
  4144. begin
  4145. if (ID <> 0) then
  4146. glDeleteTextures(1, @fID);
  4147. glGenTextures(1, @fID);
  4148. Bind(false);
  4149. end;
  4150. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4151. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  4152. begin
  4153. // Set Up Parameters
  4154. SetWrap(fWrapS, fWrapT, fWrapR);
  4155. SetFilter(fFilterMin, fFilterMag);
  4156. SetAnisotropic(fAnisotropic);
  4157. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  4158. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4159. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  4160. // Mip Maps Generation Mode
  4161. aBuildWithGlu := false;
  4162. if (MipMap = mmMipmap) then begin
  4163. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  4164. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  4165. else
  4166. aBuildWithGlu := true;
  4167. end else if (MipMap = mmMipmapGlu) then
  4168. aBuildWithGlu := true;
  4169. end;
  4170. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4171. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  4172. const aWidth: Integer; const aHeight: Integer);
  4173. var
  4174. s: Single;
  4175. begin
  4176. if (Data <> aData) then begin
  4177. if (Assigned(Data)) then
  4178. FreeMem(Data);
  4179. fData := aData;
  4180. end;
  4181. if not Assigned(fData) then begin
  4182. fPixelSize := 0;
  4183. fRowSize := 0;
  4184. end else begin
  4185. FillChar(fDimension, SizeOf(fDimension), 0);
  4186. if aWidth <> -1 then begin
  4187. fDimension.Fields := fDimension.Fields + [ffX];
  4188. fDimension.X := aWidth;
  4189. end;
  4190. if aHeight <> -1 then begin
  4191. fDimension.Fields := fDimension.Fields + [ffY];
  4192. fDimension.Y := aHeight;
  4193. end;
  4194. s := TFormatDescriptor.Get(aFormat).PixelSize;
  4195. fFormat := aFormat;
  4196. fPixelSize := Ceil(s);
  4197. fRowSize := Ceil(s * aWidth);
  4198. end;
  4199. end;
  4200. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4201. function TglBitmap.FlipHorz: Boolean;
  4202. begin
  4203. result := false;
  4204. end;
  4205. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4206. function TglBitmap.FlipVert: Boolean;
  4207. begin
  4208. result := false;
  4209. end;
  4210. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4211. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4212. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4213. procedure TglBitmap.AfterConstruction;
  4214. begin
  4215. inherited AfterConstruction;
  4216. fID := 0;
  4217. fTarget := 0;
  4218. fIsResident := false;
  4219. fMipMap := glBitmapDefaultMipmap;
  4220. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  4221. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  4222. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  4223. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  4224. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  4225. end;
  4226. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4227. procedure TglBitmap.BeforeDestruction;
  4228. var
  4229. NewData: PByte;
  4230. begin
  4231. if fFreeDataOnDestroy then begin
  4232. NewData := nil;
  4233. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  4234. end;
  4235. if (fID > 0) and fDeleteTextureOnFree then
  4236. glDeleteTextures(1, @fID);
  4237. inherited BeforeDestruction;
  4238. end;
  4239. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4240. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  4241. var
  4242. TempPos: Integer;
  4243. begin
  4244. if not Assigned(aResType) then begin
  4245. TempPos := Pos('.', aResource);
  4246. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  4247. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  4248. end;
  4249. end;
  4250. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4251. procedure TglBitmap.LoadFromFile(const aFilename: String);
  4252. var
  4253. fs: TFileStream;
  4254. begin
  4255. if not FileExists(aFilename) then
  4256. raise EglBitmap.Create('file does not exist: ' + aFilename);
  4257. fFilename := aFilename;
  4258. fs := TFileStream.Create(fFilename, fmOpenRead);
  4259. try
  4260. fs.Position := 0;
  4261. LoadFromStream(fs);
  4262. finally
  4263. fs.Free;
  4264. end;
  4265. end;
  4266. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4267. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  4268. begin
  4269. {$IFDEF GLB_SUPPORT_PNG_READ}
  4270. if not LoadPNG(aStream) then
  4271. {$ENDIF}
  4272. {$IFDEF GLB_SUPPORT_JPEG_READ}
  4273. if not LoadJPEG(aStream) then
  4274. {$ENDIF}
  4275. if not LoadDDS(aStream) then
  4276. if not LoadTGA(aStream) then
  4277. if not LoadBMP(aStream) then
  4278. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  4279. end;
  4280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4281. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  4282. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  4283. var
  4284. tmpData: PByte;
  4285. size: Integer;
  4286. begin
  4287. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4288. GetMem(tmpData, size);
  4289. try
  4290. FillChar(tmpData^, size, #$FF);
  4291. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4292. except
  4293. if Assigned(tmpData) then
  4294. FreeMem(tmpData);
  4295. raise;
  4296. end;
  4297. AddFunc(Self, aFunc, false, aFormat, aArgs);
  4298. end;
  4299. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4300. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  4301. var
  4302. rs: TResourceStream;
  4303. begin
  4304. PrepareResType(aResource, aResType);
  4305. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4306. try
  4307. LoadFromStream(rs);
  4308. finally
  4309. rs.Free;
  4310. end;
  4311. end;
  4312. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4313. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4314. var
  4315. rs: TResourceStream;
  4316. begin
  4317. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4318. try
  4319. LoadFromStream(rs);
  4320. finally
  4321. rs.Free;
  4322. end;
  4323. end;
  4324. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4325. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  4326. var
  4327. fs: TFileStream;
  4328. begin
  4329. fs := TFileStream.Create(aFileName, fmCreate);
  4330. try
  4331. fs.Position := 0;
  4332. SaveToStream(fs, aFileType);
  4333. finally
  4334. fs.Free;
  4335. end;
  4336. end;
  4337. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4338. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  4339. begin
  4340. case aFileType of
  4341. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4342. ftPNG: SavePNG(aStream);
  4343. {$ENDIF}
  4344. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  4345. ftJPEG: SaveJPEG(aStream);
  4346. {$ENDIF}
  4347. ftDDS: SaveDDS(aStream);
  4348. ftTGA: SaveTGA(aStream);
  4349. ftBMP: SaveBMP(aStream);
  4350. end;
  4351. end;
  4352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4353. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  4354. begin
  4355. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  4356. end;
  4357. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4358. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  4359. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  4360. var
  4361. DestData, TmpData, SourceData: pByte;
  4362. TempHeight, TempWidth: Integer;
  4363. SourceFD, DestFD: TFormatDescriptor;
  4364. SourceMD, DestMD: Pointer;
  4365. FuncRec: TglBitmapFunctionRec;
  4366. begin
  4367. Assert(Assigned(Data));
  4368. Assert(Assigned(aSource));
  4369. Assert(Assigned(aSource.Data));
  4370. result := false;
  4371. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  4372. SourceFD := TFormatDescriptor.Get(aSource.Format);
  4373. DestFD := TFormatDescriptor.Get(aFormat);
  4374. if (SourceFD.IsCompressed) then
  4375. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  4376. if (DestFD.IsCompressed) then
  4377. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  4378. // inkompatible Formats so CreateTemp
  4379. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  4380. aCreateTemp := true;
  4381. // Values
  4382. TempHeight := Max(1, aSource.Height);
  4383. TempWidth := Max(1, aSource.Width);
  4384. FuncRec.Sender := Self;
  4385. FuncRec.Args := aArgs;
  4386. TmpData := nil;
  4387. if aCreateTemp then begin
  4388. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  4389. DestData := TmpData;
  4390. end else
  4391. DestData := Data;
  4392. try
  4393. SourceFD.PreparePixel(FuncRec.Source);
  4394. DestFD.PreparePixel (FuncRec.Dest);
  4395. SourceMD := SourceFD.CreateMappingData;
  4396. DestMD := DestFD.CreateMappingData;
  4397. FuncRec.Size := aSource.Dimension;
  4398. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4399. try
  4400. SourceData := aSource.Data;
  4401. FuncRec.Position.Y := 0;
  4402. while FuncRec.Position.Y < TempHeight do begin
  4403. FuncRec.Position.X := 0;
  4404. while FuncRec.Position.X < TempWidth do begin
  4405. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4406. aFunc(FuncRec);
  4407. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  4408. inc(FuncRec.Position.X);
  4409. end;
  4410. inc(FuncRec.Position.Y);
  4411. end;
  4412. // Updating Image or InternalFormat
  4413. if aCreateTemp then
  4414. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  4415. else if (aFormat <> fFormat) then
  4416. Format := aFormat;
  4417. result := true;
  4418. finally
  4419. SourceFD.FreeMappingData(SourceMD);
  4420. DestFD.FreeMappingData(DestMD);
  4421. end;
  4422. except
  4423. if aCreateTemp and Assigned(TmpData) then
  4424. FreeMem(TmpData);
  4425. raise;
  4426. end;
  4427. end;
  4428. end;
  4429. {$IFDEF GLB_SDL}
  4430. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4431. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  4432. var
  4433. Row, RowSize: Integer;
  4434. SourceData, TmpData: PByte;
  4435. TempDepth: Integer;
  4436. FormatDesc: TFormatDescriptor;
  4437. function GetRowPointer(Row: Integer): pByte;
  4438. begin
  4439. result := aSurface.pixels;
  4440. Inc(result, Row * RowSize);
  4441. end;
  4442. begin
  4443. result := false;
  4444. FormatDesc := TFormatDescriptor.Get(Format);
  4445. if FormatDesc.IsCompressed then
  4446. raise EglBitmapUnsupportedFormat.Create(Format);
  4447. if Assigned(Data) then begin
  4448. case Trunc(FormatDesc.PixelSize) of
  4449. 1: TempDepth := 8;
  4450. 2: TempDepth := 16;
  4451. 3: TempDepth := 24;
  4452. 4: TempDepth := 32;
  4453. else
  4454. raise EglBitmapUnsupportedFormat.Create(Format);
  4455. end;
  4456. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4457. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4458. SourceData := Data;
  4459. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4460. for Row := 0 to FileHeight-1 do begin
  4461. TmpData := GetRowPointer(Row);
  4462. if Assigned(TmpData) then begin
  4463. Move(SourceData^, TmpData^, RowSize);
  4464. inc(SourceData, RowSize);
  4465. end;
  4466. end;
  4467. result := true;
  4468. end;
  4469. end;
  4470. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4471. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4472. var
  4473. pSource, pData, pTempData: PByte;
  4474. Row, RowSize, TempWidth, TempHeight: Integer;
  4475. IntFormat: TglBitmapFormat;
  4476. FormatDesc: TFormatDescriptor;
  4477. function GetRowPointer(Row: Integer): pByte;
  4478. begin
  4479. result := aSurface^.pixels;
  4480. Inc(result, Row * RowSize);
  4481. end;
  4482. begin
  4483. result := false;
  4484. if (Assigned(aSurface)) then begin
  4485. with aSurface^.format^ do begin
  4486. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  4487. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4488. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  4489. break;
  4490. end;
  4491. if (IntFormat = tfEmpty) then
  4492. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  4493. end;
  4494. TempWidth := aSurface^.w;
  4495. TempHeight := aSurface^.h;
  4496. RowSize := FormatDesc.GetSize(TempWidth, 1);
  4497. GetMem(pData, TempHeight * RowSize);
  4498. try
  4499. pTempData := pData;
  4500. for Row := 0 to TempHeight -1 do begin
  4501. pSource := GetRowPointer(Row);
  4502. if (Assigned(pSource)) then begin
  4503. Move(pSource^, pTempData^, RowSize);
  4504. Inc(pTempData, RowSize);
  4505. end;
  4506. end;
  4507. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4508. result := true;
  4509. except
  4510. if Assigned(pData) then
  4511. FreeMem(pData);
  4512. raise;
  4513. end;
  4514. end;
  4515. end;
  4516. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4517. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4518. var
  4519. Row, Col, AlphaInterleave: Integer;
  4520. pSource, pDest: PByte;
  4521. function GetRowPointer(Row: Integer): pByte;
  4522. begin
  4523. result := aSurface.pixels;
  4524. Inc(result, Row * Width);
  4525. end;
  4526. begin
  4527. result := false;
  4528. if Assigned(Data) then begin
  4529. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  4530. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4531. AlphaInterleave := 0;
  4532. case Format of
  4533. tfLuminance8Alpha8:
  4534. AlphaInterleave := 1;
  4535. tfBGRA8, tfRGBA8:
  4536. AlphaInterleave := 3;
  4537. end;
  4538. pSource := Data;
  4539. for Row := 0 to Height -1 do begin
  4540. pDest := GetRowPointer(Row);
  4541. if Assigned(pDest) then begin
  4542. for Col := 0 to Width -1 do begin
  4543. Inc(pSource, AlphaInterleave);
  4544. pDest^ := pSource^;
  4545. Inc(pDest);
  4546. Inc(pSource);
  4547. end;
  4548. end;
  4549. end;
  4550. result := true;
  4551. end;
  4552. end;
  4553. end;
  4554. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4555. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4556. var
  4557. bmp: TglBitmap2D;
  4558. begin
  4559. bmp := TglBitmap2D.Create;
  4560. try
  4561. bmp.AssignFromSurface(aSurface);
  4562. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4563. finally
  4564. bmp.Free;
  4565. end;
  4566. end;
  4567. {$ENDIF}
  4568. {$IFDEF GLB_DELPHI}
  4569. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4570. function CreateGrayPalette: HPALETTE;
  4571. var
  4572. Idx: Integer;
  4573. Pal: PLogPalette;
  4574. begin
  4575. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4576. Pal.palVersion := $300;
  4577. Pal.palNumEntries := 256;
  4578. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4579. Pal.palPalEntry[Idx].peRed := Idx;
  4580. Pal.palPalEntry[Idx].peGreen := Idx;
  4581. Pal.palPalEntry[Idx].peBlue := Idx;
  4582. Pal.palPalEntry[Idx].peFlags := 0;
  4583. end;
  4584. Result := CreatePalette(Pal^);
  4585. FreeMem(Pal);
  4586. end;
  4587. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4588. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4589. var
  4590. Row: Integer;
  4591. pSource, pData: PByte;
  4592. begin
  4593. result := false;
  4594. if Assigned(Data) then begin
  4595. if Assigned(aBitmap) then begin
  4596. aBitmap.Width := Width;
  4597. aBitmap.Height := Height;
  4598. case Format of
  4599. tfAlpha8, tfLuminance8: begin
  4600. aBitmap.PixelFormat := pf8bit;
  4601. aBitmap.Palette := CreateGrayPalette;
  4602. end;
  4603. tfRGB5A1:
  4604. aBitmap.PixelFormat := pf15bit;
  4605. tfR5G6B5:
  4606. aBitmap.PixelFormat := pf16bit;
  4607. tfRGB8, tfBGR8:
  4608. aBitmap.PixelFormat := pf24bit;
  4609. tfRGBA8, tfBGRA8:
  4610. aBitmap.PixelFormat := pf32bit;
  4611. else
  4612. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4613. end;
  4614. pSource := Data;
  4615. for Row := 0 to FileHeight -1 do begin
  4616. pData := aBitmap.Scanline[Row];
  4617. Move(pSource^, pData^, fRowSize);
  4618. Inc(pSource, fRowSize);
  4619. if (Format in [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A)
  4620. SwapRGB(pData, FileWidth, Format = tfRGBA8);
  4621. end;
  4622. result := true;
  4623. end;
  4624. end;
  4625. end;
  4626. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4627. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4628. var
  4629. pSource, pData, pTempData: PByte;
  4630. Row, RowSize, TempWidth, TempHeight: Integer;
  4631. IntFormat: TglBitmapFormat;
  4632. begin
  4633. result := false;
  4634. if (Assigned(aBitmap)) then begin
  4635. case aBitmap.PixelFormat of
  4636. pf8bit:
  4637. IntFormat := tfLuminance8;
  4638. pf15bit:
  4639. IntFormat := tfRGB5A1;
  4640. pf16bit:
  4641. IntFormat := tfR5G6B5;
  4642. pf24bit:
  4643. IntFormat := tfBGR8;
  4644. pf32bit:
  4645. IntFormat := tfBGRA8;
  4646. else
  4647. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4648. end;
  4649. TempWidth := aBitmap.Width;
  4650. TempHeight := aBitmap.Height;
  4651. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4652. GetMem(pData, TempHeight * RowSize);
  4653. try
  4654. pTempData := pData;
  4655. for Row := 0 to TempHeight -1 do begin
  4656. pSource := aBitmap.Scanline[Row];
  4657. if (Assigned(pSource)) then begin
  4658. Move(pSource^, pTempData^, RowSize);
  4659. Inc(pTempData, RowSize);
  4660. end;
  4661. end;
  4662. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4663. result := true;
  4664. except
  4665. if Assigned(pData) then
  4666. FreeMem(pData);
  4667. raise;
  4668. end;
  4669. end;
  4670. end;
  4671. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4672. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4673. var
  4674. Row, Col, AlphaInterleave: Integer;
  4675. pSource, pDest: PByte;
  4676. begin
  4677. result := false;
  4678. if Assigned(Data) then begin
  4679. if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
  4680. if Assigned(aBitmap) then begin
  4681. aBitmap.PixelFormat := pf8bit;
  4682. aBitmap.Palette := CreateGrayPalette;
  4683. aBitmap.Width := Width;
  4684. aBitmap.Height := Height;
  4685. case Format of
  4686. tfLuminance8Alpha8:
  4687. AlphaInterleave := 1;
  4688. tfRGBA8, tfBGRA8:
  4689. AlphaInterleave := 3;
  4690. else
  4691. AlphaInterleave := 0;
  4692. end;
  4693. // Copy Data
  4694. pSource := Data;
  4695. for Row := 0 to Height -1 do begin
  4696. pDest := aBitmap.Scanline[Row];
  4697. if Assigned(pDest) then begin
  4698. for Col := 0 to Width -1 do begin
  4699. Inc(pSource, AlphaInterleave);
  4700. pDest^ := pSource^;
  4701. Inc(pDest);
  4702. Inc(pSource);
  4703. end;
  4704. end;
  4705. end;
  4706. result := true;
  4707. end;
  4708. end;
  4709. end;
  4710. end;
  4711. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4712. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4713. var
  4714. tex: TglBitmap2D;
  4715. begin
  4716. tex := TglBitmap2D.Create;
  4717. try
  4718. tex.AssignFromBitmap(ABitmap);
  4719. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4720. finally
  4721. tex.Free;
  4722. end;
  4723. end;
  4724. {$ENDIF}
  4725. {$IFDEF GLB_LAZARUS}
  4726. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4727. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4728. var
  4729. rid: TRawImageDescription;
  4730. FormatDesc: TFormatDescriptor;
  4731. begin
  4732. result := false;
  4733. if not Assigned(aImage) or (Format = tfEmpty) then
  4734. exit;
  4735. FormatDesc := TFormatDescriptor.Get(Format);
  4736. if FormatDesc.IsCompressed then
  4737. exit;
  4738. FillChar(rid{%H-}, SizeOf(rid), 0);
  4739. if (Format in [
  4740. tfAlpha4, tfAlpha8, tfAlpha16,
  4741. tfLuminance4, tfLuminance8, tfLuminance16,
  4742. tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance16Alpha16]) then
  4743. rid.Format := ricfGray
  4744. else
  4745. rid.Format := ricfRGBA;
  4746. rid.Width := Width;
  4747. rid.Height := Height;
  4748. rid.Depth := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
  4749. rid.BitOrder := riboBitsInOrder;
  4750. rid.ByteOrder := riboLSBFirst;
  4751. rid.LineOrder := riloTopToBottom;
  4752. rid.LineEnd := rileTight;
  4753. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4754. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4755. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4756. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4757. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4758. rid.RedShift := FormatDesc.Shift.r;
  4759. rid.GreenShift := FormatDesc.Shift.g;
  4760. rid.BlueShift := FormatDesc.Shift.b;
  4761. rid.AlphaShift := FormatDesc.Shift.a;
  4762. rid.MaskBitsPerPixel := 0;
  4763. rid.PaletteColorCount := 0;
  4764. aImage.DataDescription := rid;
  4765. aImage.CreateData;
  4766. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4767. result := true;
  4768. end;
  4769. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4770. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4771. var
  4772. f: TglBitmapFormat;
  4773. FormatDesc: TFormatDescriptor;
  4774. ImageData: PByte;
  4775. ImageSize: Integer;
  4776. CanCopy: Boolean;
  4777. procedure CopyConvert;
  4778. var
  4779. bfFormat: TbmpBitfieldFormat;
  4780. pSourceLine, pDestLine: PByte;
  4781. pSourceMD, pDestMD: Pointer;
  4782. x, y: Integer;
  4783. pixel: TglBitmapPixelData;
  4784. begin
  4785. bfFormat := TbmpBitfieldFormat.Create;
  4786. with aImage.DataDescription do begin
  4787. bfFormat.RedMask := ((1 shl RedPrec) - 1) shl RedShift;
  4788. bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
  4789. bfFormat.BlueMask := ((1 shl BluePrec) - 1) shl BlueShift;
  4790. bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
  4791. bfFormat.PixelSize := BitsPerPixel / 8;
  4792. end;
  4793. pSourceMD := bfFormat.CreateMappingData;
  4794. pDestMD := FormatDesc.CreateMappingData;
  4795. try
  4796. for y := 0 to aImage.Height-1 do begin
  4797. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  4798. pDestLine := ImageData + y * Round(FormatDesc.PixelSize * aImage.Width);
  4799. for x := 0 to aImage.Width-1 do begin
  4800. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  4801. FormatDesc.Map(pixel, pDestLine, pDestMD);
  4802. end;
  4803. end;
  4804. finally
  4805. FormatDesc.FreeMappingData(pDestMD);
  4806. bfFormat.FreeMappingData(pSourceMD);
  4807. bfFormat.Free;
  4808. end;
  4809. end;
  4810. begin
  4811. result := false;
  4812. if not Assigned(aImage) then
  4813. exit;
  4814. for f := High(f) downto Low(f) do begin
  4815. FormatDesc := TFormatDescriptor.Get(f);
  4816. with aImage.DataDescription do
  4817. if FormatDesc.MaskMatch(
  4818. (QWord(1 shl RedPrec )-1) shl RedShift,
  4819. (QWord(1 shl GreenPrec)-1) shl GreenShift,
  4820. (QWord(1 shl BluePrec )-1) shl BlueShift,
  4821. (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
  4822. break;
  4823. end;
  4824. if (f = tfEmpty) then
  4825. exit;
  4826. CanCopy :=
  4827. (Round(FormatDesc.PixelSize * 8) = aImage.DataDescription.Depth) and
  4828. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  4829. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4830. ImageData := GetMem(ImageSize);
  4831. try
  4832. if CanCopy then
  4833. Move(aImage.PixelData^, ImageData^, ImageSize)
  4834. else
  4835. CopyConvert;
  4836. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4837. except
  4838. if Assigned(ImageData) then
  4839. FreeMem(ImageData);
  4840. raise;
  4841. end;
  4842. result := true;
  4843. end;
  4844. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4845. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4846. var
  4847. rid: TRawImageDescription;
  4848. FormatDesc: TFormatDescriptor;
  4849. Pixel: TglBitmapPixelData;
  4850. x, y: Integer;
  4851. srcMD: Pointer;
  4852. src, dst: PByte;
  4853. begin
  4854. result := false;
  4855. if not Assigned(aImage) or (Format = tfEmpty) then
  4856. exit;
  4857. FormatDesc := TFormatDescriptor.Get(Format);
  4858. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4859. exit;
  4860. FillChar(rid{%H-}, SizeOf(rid), 0);
  4861. rid.Format := ricfGray;
  4862. rid.Width := Width;
  4863. rid.Height := Height;
  4864. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4865. rid.BitOrder := riboBitsInOrder;
  4866. rid.ByteOrder := riboLSBFirst;
  4867. rid.LineOrder := riloTopToBottom;
  4868. rid.LineEnd := rileTight;
  4869. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4870. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4871. rid.GreenPrec := 0;
  4872. rid.BluePrec := 0;
  4873. rid.AlphaPrec := 0;
  4874. rid.RedShift := 0;
  4875. rid.GreenShift := 0;
  4876. rid.BlueShift := 0;
  4877. rid.AlphaShift := 0;
  4878. rid.MaskBitsPerPixel := 0;
  4879. rid.PaletteColorCount := 0;
  4880. aImage.DataDescription := rid;
  4881. aImage.CreateData;
  4882. srcMD := FormatDesc.CreateMappingData;
  4883. try
  4884. FormatDesc.PreparePixel(Pixel);
  4885. src := Data;
  4886. dst := aImage.PixelData;
  4887. for y := 0 to Height-1 do
  4888. for x := 0 to Width-1 do begin
  4889. FormatDesc.Unmap(src, Pixel, srcMD);
  4890. case rid.BitsPerPixel of
  4891. 8: begin
  4892. dst^ := Pixel.Data.a;
  4893. inc(dst);
  4894. end;
  4895. 16: begin
  4896. PWord(dst)^ := Pixel.Data.a;
  4897. inc(dst, 2);
  4898. end;
  4899. 24: begin
  4900. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4901. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4902. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4903. inc(dst, 3);
  4904. end;
  4905. 32: begin
  4906. PCardinal(dst)^ := Pixel.Data.a;
  4907. inc(dst, 4);
  4908. end;
  4909. else
  4910. raise EglBitmapUnsupportedFormat.Create(Format);
  4911. end;
  4912. end;
  4913. finally
  4914. FormatDesc.FreeMappingData(srcMD);
  4915. end;
  4916. result := true;
  4917. end;
  4918. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4919. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4920. var
  4921. tex: TglBitmap2D;
  4922. begin
  4923. tex := TglBitmap2D.Create;
  4924. try
  4925. tex.AssignFromLazIntfImage(aImage);
  4926. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4927. finally
  4928. tex.Free;
  4929. end;
  4930. end;
  4931. {$ENDIF}
  4932. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4933. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4934. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4935. var
  4936. rs: TResourceStream;
  4937. begin
  4938. PrepareResType(aResource, aResType);
  4939. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4940. try
  4941. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4942. finally
  4943. rs.Free;
  4944. end;
  4945. end;
  4946. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4947. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4948. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4949. var
  4950. rs: TResourceStream;
  4951. begin
  4952. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4953. try
  4954. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4955. finally
  4956. rs.Free;
  4957. end;
  4958. end;
  4959. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4960. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4961. begin
  4962. if TFormatDescriptor.Get(Format).IsCompressed then
  4963. raise EglBitmapUnsupportedFormat.Create(Format);
  4964. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4965. end;
  4966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4967. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4968. var
  4969. FS: TFileStream;
  4970. begin
  4971. FS := TFileStream.Create(aFileName, fmOpenRead);
  4972. try
  4973. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4974. finally
  4975. FS.Free;
  4976. end;
  4977. end;
  4978. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4979. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4980. var
  4981. tex: TglBitmap2D;
  4982. begin
  4983. tex := TglBitmap2D.Create(aStream);
  4984. try
  4985. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4986. finally
  4987. tex.Free;
  4988. end;
  4989. end;
  4990. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4991. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4992. var
  4993. DestData, DestData2, SourceData: pByte;
  4994. TempHeight, TempWidth: Integer;
  4995. SourceFD, DestFD: TFormatDescriptor;
  4996. SourceMD, DestMD, DestMD2: Pointer;
  4997. FuncRec: TglBitmapFunctionRec;
  4998. begin
  4999. result := false;
  5000. Assert(Assigned(Data));
  5001. Assert(Assigned(aBitmap));
  5002. Assert(Assigned(aBitmap.Data));
  5003. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  5004. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  5005. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  5006. DestFD := TFormatDescriptor.Get(Format);
  5007. if not Assigned(aFunc) then begin
  5008. aFunc := glBitmapAlphaFunc;
  5009. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  5010. end else
  5011. FuncRec.Args := aArgs;
  5012. // Values
  5013. TempHeight := aBitmap.FileHeight;
  5014. TempWidth := aBitmap.FileWidth;
  5015. FuncRec.Sender := Self;
  5016. FuncRec.Size := Dimension;
  5017. FuncRec.Position.Fields := FuncRec.Size.Fields;
  5018. DestData := Data;
  5019. DestData2 := Data;
  5020. SourceData := aBitmap.Data;
  5021. // Mapping
  5022. SourceFD.PreparePixel(FuncRec.Source);
  5023. DestFD.PreparePixel (FuncRec.Dest);
  5024. SourceMD := SourceFD.CreateMappingData;
  5025. DestMD := DestFD.CreateMappingData;
  5026. DestMD2 := DestFD.CreateMappingData;
  5027. try
  5028. FuncRec.Position.Y := 0;
  5029. while FuncRec.Position.Y < TempHeight do begin
  5030. FuncRec.Position.X := 0;
  5031. while FuncRec.Position.X < TempWidth do begin
  5032. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  5033. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  5034. aFunc(FuncRec);
  5035. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  5036. inc(FuncRec.Position.X);
  5037. end;
  5038. inc(FuncRec.Position.Y);
  5039. end;
  5040. finally
  5041. SourceFD.FreeMappingData(SourceMD);
  5042. DestFD.FreeMappingData(DestMD);
  5043. DestFD.FreeMappingData(DestMD2);
  5044. end;
  5045. end;
  5046. end;
  5047. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5048. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  5049. begin
  5050. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  5051. end;
  5052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5053. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  5054. var
  5055. PixelData: TglBitmapPixelData;
  5056. begin
  5057. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5058. result := AddAlphaFromColorKeyFloat(
  5059. aRed / PixelData.Range.r,
  5060. aGreen / PixelData.Range.g,
  5061. aBlue / PixelData.Range.b,
  5062. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  5063. end;
  5064. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5065. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  5066. var
  5067. values: array[0..2] of Single;
  5068. tmp: Cardinal;
  5069. i: Integer;
  5070. PixelData: TglBitmapPixelData;
  5071. begin
  5072. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5073. with PixelData do begin
  5074. values[0] := aRed;
  5075. values[1] := aGreen;
  5076. values[2] := aBlue;
  5077. for i := 0 to 2 do begin
  5078. tmp := Trunc(Range.arr[i] * aDeviation);
  5079. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  5080. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  5081. end;
  5082. Data.a := 0;
  5083. Range.a := 0;
  5084. end;
  5085. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  5086. end;
  5087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5088. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  5089. begin
  5090. result := AddAlphaFromValueFloat(aAlpha / $FF);
  5091. end;
  5092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5093. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  5094. var
  5095. PixelData: TglBitmapPixelData;
  5096. begin
  5097. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5098. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  5099. end;
  5100. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5101. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  5102. var
  5103. PixelData: TglBitmapPixelData;
  5104. begin
  5105. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5106. with PixelData do
  5107. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  5108. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  5109. end;
  5110. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5111. function TglBitmap.RemoveAlpha: Boolean;
  5112. var
  5113. FormatDesc: TFormatDescriptor;
  5114. begin
  5115. result := false;
  5116. FormatDesc := TFormatDescriptor.Get(Format);
  5117. if Assigned(Data) then begin
  5118. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  5119. raise EglBitmapUnsupportedFormat.Create(Format);
  5120. result := ConvertTo(FormatDesc.WithoutAlpha);
  5121. end;
  5122. end;
  5123. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5124. function TglBitmap.Clone: TglBitmap;
  5125. var
  5126. Temp: TglBitmap;
  5127. TempPtr: PByte;
  5128. Size: Integer;
  5129. begin
  5130. result := nil;
  5131. Temp := (ClassType.Create as TglBitmap);
  5132. try
  5133. // copy texture data if assigned
  5134. if Assigned(Data) then begin
  5135. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  5136. GetMem(TempPtr, Size);
  5137. try
  5138. Move(Data^, TempPtr^, Size);
  5139. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  5140. except
  5141. if Assigned(TempPtr) then
  5142. FreeMem(TempPtr);
  5143. raise;
  5144. end;
  5145. end else begin
  5146. TempPtr := nil;
  5147. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  5148. end;
  5149. // copy properties
  5150. Temp.fID := ID;
  5151. Temp.fTarget := Target;
  5152. Temp.fFormat := Format;
  5153. Temp.fMipMap := MipMap;
  5154. Temp.fAnisotropic := Anisotropic;
  5155. Temp.fBorderColor := fBorderColor;
  5156. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  5157. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  5158. Temp.fFilterMin := fFilterMin;
  5159. Temp.fFilterMag := fFilterMag;
  5160. Temp.fWrapS := fWrapS;
  5161. Temp.fWrapT := fWrapT;
  5162. Temp.fWrapR := fWrapR;
  5163. Temp.fFilename := fFilename;
  5164. Temp.fCustomName := fCustomName;
  5165. Temp.fCustomNameW := fCustomNameW;
  5166. Temp.fCustomData := fCustomData;
  5167. result := Temp;
  5168. except
  5169. FreeAndNil(Temp);
  5170. raise;
  5171. end;
  5172. end;
  5173. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5174. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  5175. var
  5176. SourceFD, DestFD: TFormatDescriptor;
  5177. SourcePD, DestPD: TglBitmapPixelData;
  5178. ShiftData: TShiftData;
  5179. function DataIsIdentical: Boolean;
  5180. begin
  5181. result :=
  5182. (SourceFD.RedMask = DestFD.RedMask) and
  5183. (SourceFD.GreenMask = DestFD.GreenMask) and
  5184. (SourceFD.BlueMask = DestFD.BlueMask) and
  5185. (SourceFD.AlphaMask = DestFD.AlphaMask);
  5186. end;
  5187. function CanCopyDirect: Boolean;
  5188. begin
  5189. result :=
  5190. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5191. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5192. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5193. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5194. end;
  5195. function CanShift: Boolean;
  5196. begin
  5197. result :=
  5198. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5199. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5200. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5201. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5202. end;
  5203. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  5204. begin
  5205. result := 0;
  5206. while (aSource > aDest) and (aSource > 0) do begin
  5207. inc(result);
  5208. aSource := aSource shr 1;
  5209. end;
  5210. end;
  5211. begin
  5212. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  5213. SourceFD := TFormatDescriptor.Get(Format);
  5214. DestFD := TFormatDescriptor.Get(aFormat);
  5215. if DataIsIdentical then begin
  5216. result := true;
  5217. Format := aFormat;
  5218. exit;
  5219. end;
  5220. SourceFD.PreparePixel(SourcePD);
  5221. DestFD.PreparePixel (DestPD);
  5222. if CanCopyDirect then
  5223. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  5224. else if CanShift then begin
  5225. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  5226. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  5227. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  5228. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  5229. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  5230. end else
  5231. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  5232. end else
  5233. result := true;
  5234. end;
  5235. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5236. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  5237. begin
  5238. if aUseRGB or aUseAlpha then
  5239. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  5240. ((Byte(aUseAlpha) and 1) shl 1) or
  5241. (Byte(aUseRGB) and 1) ));
  5242. end;
  5243. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5244. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  5245. begin
  5246. fBorderColor[0] := aRed;
  5247. fBorderColor[1] := aGreen;
  5248. fBorderColor[2] := aBlue;
  5249. fBorderColor[3] := aAlpha;
  5250. if (ID > 0) then begin
  5251. Bind(false);
  5252. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  5253. end;
  5254. end;
  5255. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5256. procedure TglBitmap.FreeData;
  5257. var
  5258. TempPtr: PByte;
  5259. begin
  5260. TempPtr := nil;
  5261. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  5262. end;
  5263. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5264. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  5265. const aAlpha: Byte);
  5266. begin
  5267. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  5268. end;
  5269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5270. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  5271. var
  5272. PixelData: TglBitmapPixelData;
  5273. begin
  5274. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5275. FillWithColorFloat(
  5276. aRed / PixelData.Range.r,
  5277. aGreen / PixelData.Range.g,
  5278. aBlue / PixelData.Range.b,
  5279. aAlpha / PixelData.Range.a);
  5280. end;
  5281. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5282. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  5283. var
  5284. PixelData: TglBitmapPixelData;
  5285. begin
  5286. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  5287. with PixelData do begin
  5288. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  5289. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  5290. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  5291. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  5292. end;
  5293. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  5294. end;
  5295. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5296. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  5297. begin
  5298. //check MIN filter
  5299. case aMin of
  5300. GL_NEAREST:
  5301. fFilterMin := GL_NEAREST;
  5302. GL_LINEAR:
  5303. fFilterMin := GL_LINEAR;
  5304. GL_NEAREST_MIPMAP_NEAREST:
  5305. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  5306. GL_LINEAR_MIPMAP_NEAREST:
  5307. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  5308. GL_NEAREST_MIPMAP_LINEAR:
  5309. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  5310. GL_LINEAR_MIPMAP_LINEAR:
  5311. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  5312. else
  5313. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  5314. end;
  5315. //check MAG filter
  5316. case aMag of
  5317. GL_NEAREST:
  5318. fFilterMag := GL_NEAREST;
  5319. GL_LINEAR:
  5320. fFilterMag := GL_LINEAR;
  5321. else
  5322. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  5323. end;
  5324. //apply filter
  5325. if (ID > 0) then begin
  5326. Bind(false);
  5327. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  5328. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  5329. case fFilterMin of
  5330. GL_NEAREST, GL_LINEAR:
  5331. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5332. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  5333. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  5334. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  5335. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  5336. end;
  5337. end else
  5338. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5339. end;
  5340. end;
  5341. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5342. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  5343. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  5344. begin
  5345. case aValue of
  5346. GL_CLAMP:
  5347. aTarget := GL_CLAMP;
  5348. GL_REPEAT:
  5349. aTarget := GL_REPEAT;
  5350. GL_CLAMP_TO_EDGE: begin
  5351. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  5352. aTarget := GL_CLAMP_TO_EDGE
  5353. else
  5354. aTarget := GL_CLAMP;
  5355. end;
  5356. GL_CLAMP_TO_BORDER: begin
  5357. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  5358. aTarget := GL_CLAMP_TO_BORDER
  5359. else
  5360. aTarget := GL_CLAMP;
  5361. end;
  5362. GL_MIRRORED_REPEAT: begin
  5363. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  5364. aTarget := GL_MIRRORED_REPEAT
  5365. else
  5366. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  5367. end;
  5368. else
  5369. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  5370. end;
  5371. end;
  5372. begin
  5373. CheckAndSetWrap(S, fWrapS);
  5374. CheckAndSetWrap(T, fWrapT);
  5375. CheckAndSetWrap(R, fWrapR);
  5376. if (ID > 0) then begin
  5377. Bind(false);
  5378. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  5379. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  5380. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  5381. end;
  5382. end;
  5383. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5384. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  5385. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  5386. begin
  5387. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  5388. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  5389. fSwizzle[aIndex] := aValue
  5390. else
  5391. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  5392. end;
  5393. begin
  5394. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  5395. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  5396. CheckAndSetValue(r, 0);
  5397. CheckAndSetValue(g, 1);
  5398. CheckAndSetValue(b, 2);
  5399. CheckAndSetValue(a, 3);
  5400. if (ID > 0) then begin
  5401. Bind(false);
  5402. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  5403. end;
  5404. end;
  5405. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5406. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  5407. begin
  5408. if aEnableTextureUnit then
  5409. glEnable(Target);
  5410. if (ID > 0) then
  5411. glBindTexture(Target, ID);
  5412. end;
  5413. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5414. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  5415. begin
  5416. if aDisableTextureUnit then
  5417. glDisable(Target);
  5418. glBindTexture(Target, 0);
  5419. end;
  5420. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5421. constructor TglBitmap.Create;
  5422. begin
  5423. if (ClassType = TglBitmap) then
  5424. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  5425. {$IFDEF GLB_NATIVE_OGL}
  5426. glbReadOpenGLExtensions;
  5427. {$ENDIF}
  5428. inherited Create;
  5429. fFormat := glBitmapGetDefaultFormat;
  5430. fFreeDataOnDestroy := true;
  5431. end;
  5432. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5433. constructor TglBitmap.Create(const aFileName: String);
  5434. begin
  5435. Create;
  5436. LoadFromFile(aFileName);
  5437. end;
  5438. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5439. constructor TglBitmap.Create(const aStream: TStream);
  5440. begin
  5441. Create;
  5442. LoadFromStream(aStream);
  5443. end;
  5444. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5445. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
  5446. var
  5447. ImageSize: Integer;
  5448. begin
  5449. Create;
  5450. if not Assigned(aData) then begin
  5451. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5452. GetMem(aData, ImageSize);
  5453. try
  5454. FillChar(aData^, ImageSize, #$FF);
  5455. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5456. except
  5457. if Assigned(aData) then
  5458. FreeMem(aData);
  5459. raise;
  5460. end;
  5461. end else begin
  5462. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5463. fFreeDataOnDestroy := false;
  5464. end;
  5465. end;
  5466. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5467. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5468. begin
  5469. Create;
  5470. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  5471. end;
  5472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5473. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  5474. begin
  5475. Create;
  5476. LoadFromResource(aInstance, aResource, aResType);
  5477. end;
  5478. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5479. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5480. begin
  5481. Create;
  5482. LoadFromResourceID(aInstance, aResourceID, aResType);
  5483. end;
  5484. {$IFDEF GLB_SUPPORT_PNG_READ}
  5485. {$IF DEFINED(GLB_LAZ_PNG)}
  5486. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5487. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5488. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5489. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5490. const
  5491. MAGIC_LEN = 8;
  5492. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  5493. var
  5494. reader: TLazReaderPNG;
  5495. intf: TLazIntfImage;
  5496. StreamPos: Int64;
  5497. magic: String[MAGIC_LEN];
  5498. begin
  5499. result := true;
  5500. StreamPos := aStream.Position;
  5501. SetLength(magic, MAGIC_LEN);
  5502. aStream.Read(magic[1], MAGIC_LEN);
  5503. aStream.Position := StreamPos;
  5504. if (magic <> PNG_MAGIC) then begin
  5505. result := false;
  5506. exit;
  5507. end;
  5508. intf := TLazIntfImage.Create(0, 0);
  5509. reader := TLazReaderPNG.Create;
  5510. try try
  5511. reader.UpdateDescription := true;
  5512. reader.ImageRead(aStream, intf);
  5513. AssignFromLazIntfImage(intf);
  5514. except
  5515. result := false;
  5516. aStream.Position := StreamPos;
  5517. exit;
  5518. end;
  5519. finally
  5520. reader.Free;
  5521. intf.Free;
  5522. end;
  5523. end;
  5524. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5525. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5526. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5527. var
  5528. Surface: PSDL_Surface;
  5529. RWops: PSDL_RWops;
  5530. begin
  5531. result := false;
  5532. RWops := glBitmapCreateRWops(aStream);
  5533. try
  5534. if IMG_isPNG(RWops) > 0 then begin
  5535. Surface := IMG_LoadPNG_RW(RWops);
  5536. try
  5537. AssignFromSurface(Surface);
  5538. result := true;
  5539. finally
  5540. SDL_FreeSurface(Surface);
  5541. end;
  5542. end;
  5543. finally
  5544. SDL_FreeRW(RWops);
  5545. end;
  5546. end;
  5547. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5548. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5549. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5550. begin
  5551. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5552. end;
  5553. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5554. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5555. var
  5556. StreamPos: Int64;
  5557. signature: array [0..7] of byte;
  5558. png: png_structp;
  5559. png_info: png_infop;
  5560. TempHeight, TempWidth: Integer;
  5561. Format: TglBitmapFormat;
  5562. png_data: pByte;
  5563. png_rows: array of pByte;
  5564. Row, LineSize: Integer;
  5565. begin
  5566. result := false;
  5567. if not init_libPNG then
  5568. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5569. try
  5570. // signature
  5571. StreamPos := aStream.Position;
  5572. aStream.Read(signature{%H-}, 8);
  5573. aStream.Position := StreamPos;
  5574. if png_check_sig(@signature, 8) <> 0 then begin
  5575. // png read struct
  5576. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5577. if png = nil then
  5578. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5579. // png info
  5580. png_info := png_create_info_struct(png);
  5581. if png_info = nil then begin
  5582. png_destroy_read_struct(@png, nil, nil);
  5583. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5584. end;
  5585. // set read callback
  5586. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5587. // read informations
  5588. png_read_info(png, png_info);
  5589. // size
  5590. TempHeight := png_get_image_height(png, png_info);
  5591. TempWidth := png_get_image_width(png, png_info);
  5592. // format
  5593. case png_get_color_type(png, png_info) of
  5594. PNG_COLOR_TYPE_GRAY:
  5595. Format := tfLuminance8;
  5596. PNG_COLOR_TYPE_GRAY_ALPHA:
  5597. Format := tfLuminance8Alpha8;
  5598. PNG_COLOR_TYPE_RGB:
  5599. Format := tfRGB8;
  5600. PNG_COLOR_TYPE_RGB_ALPHA:
  5601. Format := tfRGBA8;
  5602. else
  5603. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5604. end;
  5605. // cut upper 8 bit from 16 bit formats
  5606. if png_get_bit_depth(png, png_info) > 8 then
  5607. png_set_strip_16(png);
  5608. // expand bitdepth smaller than 8
  5609. if png_get_bit_depth(png, png_info) < 8 then
  5610. png_set_expand(png);
  5611. // allocating mem for scanlines
  5612. LineSize := png_get_rowbytes(png, png_info);
  5613. GetMem(png_data, TempHeight * LineSize);
  5614. try
  5615. SetLength(png_rows, TempHeight);
  5616. for Row := Low(png_rows) to High(png_rows) do begin
  5617. png_rows[Row] := png_data;
  5618. Inc(png_rows[Row], Row * LineSize);
  5619. end;
  5620. // read complete image into scanlines
  5621. png_read_image(png, @png_rows[0]);
  5622. // read end
  5623. png_read_end(png, png_info);
  5624. // destroy read struct
  5625. png_destroy_read_struct(@png, @png_info, nil);
  5626. SetLength(png_rows, 0);
  5627. // set new data
  5628. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5629. result := true;
  5630. except
  5631. if Assigned(png_data) then
  5632. FreeMem(png_data);
  5633. raise;
  5634. end;
  5635. end;
  5636. finally
  5637. quit_libPNG;
  5638. end;
  5639. end;
  5640. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5641. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5642. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5643. var
  5644. StreamPos: Int64;
  5645. Png: TPNGObject;
  5646. Header: String[8];
  5647. Row, Col, PixSize, LineSize: Integer;
  5648. NewImage, pSource, pDest, pAlpha: pByte;
  5649. PngFormat: TglBitmapFormat;
  5650. FormatDesc: TFormatDescriptor;
  5651. const
  5652. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5653. begin
  5654. result := false;
  5655. StreamPos := aStream.Position;
  5656. aStream.Read(Header[0], SizeOf(Header));
  5657. aStream.Position := StreamPos;
  5658. {Test if the header matches}
  5659. if Header = PngHeader then begin
  5660. Png := TPNGObject.Create;
  5661. try
  5662. Png.LoadFromStream(aStream);
  5663. case Png.Header.ColorType of
  5664. COLOR_GRAYSCALE:
  5665. PngFormat := tfLuminance8;
  5666. COLOR_GRAYSCALEALPHA:
  5667. PngFormat := tfLuminance8Alpha8;
  5668. COLOR_RGB:
  5669. PngFormat := tfBGR8;
  5670. COLOR_RGBALPHA:
  5671. PngFormat := tfBGRA8;
  5672. else
  5673. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5674. end;
  5675. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5676. PixSize := Round(FormatDesc.PixelSize);
  5677. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5678. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5679. try
  5680. pDest := NewImage;
  5681. case Png.Header.ColorType of
  5682. COLOR_RGB, COLOR_GRAYSCALE:
  5683. begin
  5684. for Row := 0 to Png.Height -1 do begin
  5685. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5686. Inc(pDest, LineSize);
  5687. end;
  5688. end;
  5689. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5690. begin
  5691. PixSize := PixSize -1;
  5692. for Row := 0 to Png.Height -1 do begin
  5693. pSource := Png.Scanline[Row];
  5694. pAlpha := pByte(Png.AlphaScanline[Row]);
  5695. for Col := 0 to Png.Width -1 do begin
  5696. Move (pSource^, pDest^, PixSize);
  5697. Inc(pSource, PixSize);
  5698. Inc(pDest, PixSize);
  5699. pDest^ := pAlpha^;
  5700. inc(pAlpha);
  5701. Inc(pDest);
  5702. end;
  5703. end;
  5704. end;
  5705. else
  5706. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5707. end;
  5708. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5709. result := true;
  5710. except
  5711. if Assigned(NewImage) then
  5712. FreeMem(NewImage);
  5713. raise;
  5714. end;
  5715. finally
  5716. Png.Free;
  5717. end;
  5718. end;
  5719. end;
  5720. {$IFEND}
  5721. {$ENDIF}
  5722. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5723. {$IFDEF GLB_LIB_PNG}
  5724. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5725. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5726. begin
  5727. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5728. end;
  5729. {$ENDIF}
  5730. {$IF DEFINED(GLB_LAZ_PNG)}
  5731. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5732. procedure TglBitmap.SavePNG(const aStream: TStream);
  5733. var
  5734. png: TPortableNetworkGraphic;
  5735. intf: TLazIntfImage;
  5736. raw: TRawImage;
  5737. begin
  5738. png := TPortableNetworkGraphic.Create;
  5739. intf := TLazIntfImage.Create(0, 0);
  5740. try
  5741. if not AssignToLazIntfImage(intf) then
  5742. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5743. intf.GetRawImage(raw);
  5744. png.LoadFromRawImage(raw, false);
  5745. png.SaveToStream(aStream);
  5746. finally
  5747. png.Free;
  5748. intf.Free;
  5749. end;
  5750. end;
  5751. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5752. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5753. procedure TglBitmap.SavePNG(const aStream: TStream);
  5754. var
  5755. png: png_structp;
  5756. png_info: png_infop;
  5757. png_rows: array of pByte;
  5758. LineSize: Integer;
  5759. ColorType: Integer;
  5760. Row: Integer;
  5761. FormatDesc: TFormatDescriptor;
  5762. begin
  5763. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5764. raise EglBitmapUnsupportedFormat.Create(Format);
  5765. if not init_libPNG then
  5766. raise Exception.Create('unable to initialize libPNG.');
  5767. try
  5768. case Format of
  5769. tfAlpha8, tfLuminance8:
  5770. ColorType := PNG_COLOR_TYPE_GRAY;
  5771. tfLuminance8Alpha8:
  5772. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5773. tfBGR8, tfRGB8:
  5774. ColorType := PNG_COLOR_TYPE_RGB;
  5775. tfBGRA8, tfRGBA8:
  5776. ColorType := PNG_COLOR_TYPE_RGBA;
  5777. else
  5778. raise EglBitmapUnsupportedFormat.Create(Format);
  5779. end;
  5780. FormatDesc := TFormatDescriptor.Get(Format);
  5781. LineSize := FormatDesc.GetSize(Width, 1);
  5782. // creating array for scanline
  5783. SetLength(png_rows, Height);
  5784. try
  5785. for Row := 0 to Height - 1 do begin
  5786. png_rows[Row] := Data;
  5787. Inc(png_rows[Row], Row * LineSize)
  5788. end;
  5789. // write struct
  5790. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5791. if png = nil then
  5792. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5793. // create png info
  5794. png_info := png_create_info_struct(png);
  5795. if png_info = nil then begin
  5796. png_destroy_write_struct(@png, nil);
  5797. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5798. end;
  5799. // set read callback
  5800. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5801. // set compression
  5802. png_set_compression_level(png, 6);
  5803. if Format in [tfBGR8, tfBGRA8] then
  5804. png_set_bgr(png);
  5805. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5806. png_write_info(png, png_info);
  5807. png_write_image(png, @png_rows[0]);
  5808. png_write_end(png, png_info);
  5809. png_destroy_write_struct(@png, @png_info);
  5810. finally
  5811. SetLength(png_rows, 0);
  5812. end;
  5813. finally
  5814. quit_libPNG;
  5815. end;
  5816. end;
  5817. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5818. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5819. procedure TglBitmap.SavePNG(const aStream: TStream);
  5820. var
  5821. Png: TPNGObject;
  5822. pSource, pDest: pByte;
  5823. X, Y, PixSize: Integer;
  5824. ColorType: Cardinal;
  5825. Alpha: Boolean;
  5826. pTemp: pByte;
  5827. Temp: Byte;
  5828. begin
  5829. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5830. raise EglBitmapUnsupportedFormat.Create(Format);
  5831. case Format of
  5832. tfAlpha8, tfLuminance8: begin
  5833. ColorType := COLOR_GRAYSCALE;
  5834. PixSize := 1;
  5835. Alpha := false;
  5836. end;
  5837. tfLuminance8Alpha8: begin
  5838. ColorType := COLOR_GRAYSCALEALPHA;
  5839. PixSize := 1;
  5840. Alpha := true;
  5841. end;
  5842. tfBGR8, tfRGB8: begin
  5843. ColorType := COLOR_RGB;
  5844. PixSize := 3;
  5845. Alpha := false;
  5846. end;
  5847. tfBGRA8, tfRGBA8: begin
  5848. ColorType := COLOR_RGBALPHA;
  5849. PixSize := 3;
  5850. Alpha := true
  5851. end;
  5852. else
  5853. raise EglBitmapUnsupportedFormat.Create(Format);
  5854. end;
  5855. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5856. try
  5857. // Copy ImageData
  5858. pSource := Data;
  5859. for Y := 0 to Height -1 do begin
  5860. pDest := png.ScanLine[Y];
  5861. for X := 0 to Width -1 do begin
  5862. Move(pSource^, pDest^, PixSize);
  5863. Inc(pDest, PixSize);
  5864. Inc(pSource, PixSize);
  5865. if Alpha then begin
  5866. png.AlphaScanline[Y]^[X] := pSource^;
  5867. Inc(pSource);
  5868. end;
  5869. end;
  5870. // convert RGB line to BGR
  5871. if Format in [tfRGB8, tfRGBA8] then begin
  5872. pTemp := png.ScanLine[Y];
  5873. for X := 0 to Width -1 do begin
  5874. Temp := pByteArray(pTemp)^[0];
  5875. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5876. pByteArray(pTemp)^[2] := Temp;
  5877. Inc(pTemp, 3);
  5878. end;
  5879. end;
  5880. end;
  5881. // Save to Stream
  5882. Png.CompressionLevel := 6;
  5883. Png.SaveToStream(aStream);
  5884. finally
  5885. FreeAndNil(Png);
  5886. end;
  5887. end;
  5888. {$IFEND}
  5889. {$ENDIF}
  5890. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5891. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5892. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5893. {$IFDEF GLB_LIB_JPEG}
  5894. type
  5895. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5896. glBitmap_libJPEG_source_mgr = record
  5897. pub: jpeg_source_mgr;
  5898. SrcStream: TStream;
  5899. SrcBuffer: array [1..4096] of byte;
  5900. end;
  5901. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5902. glBitmap_libJPEG_dest_mgr = record
  5903. pub: jpeg_destination_mgr;
  5904. DestStream: TStream;
  5905. DestBuffer: array [1..4096] of byte;
  5906. end;
  5907. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5908. begin
  5909. //DUMMY
  5910. end;
  5911. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5912. begin
  5913. //DUMMY
  5914. end;
  5915. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5916. begin
  5917. //DUMMY
  5918. end;
  5919. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5920. begin
  5921. //DUMMY
  5922. end;
  5923. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5924. begin
  5925. //DUMMY
  5926. end;
  5927. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5928. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5929. var
  5930. src: glBitmap_libJPEG_source_mgr_ptr;
  5931. bytes: integer;
  5932. begin
  5933. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5934. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5935. if (bytes <= 0) then begin
  5936. src^.SrcBuffer[1] := $FF;
  5937. src^.SrcBuffer[2] := JPEG_EOI;
  5938. bytes := 2;
  5939. end;
  5940. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5941. src^.pub.bytes_in_buffer := bytes;
  5942. result := true;
  5943. end;
  5944. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5945. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5946. var
  5947. src: glBitmap_libJPEG_source_mgr_ptr;
  5948. begin
  5949. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5950. if num_bytes > 0 then begin
  5951. // wanted byte isn't in buffer so set stream position and read buffer
  5952. if num_bytes > src^.pub.bytes_in_buffer then begin
  5953. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5954. src^.pub.fill_input_buffer(cinfo);
  5955. end else begin
  5956. // wanted byte is in buffer so only skip
  5957. inc(src^.pub.next_input_byte, num_bytes);
  5958. dec(src^.pub.bytes_in_buffer, num_bytes);
  5959. end;
  5960. end;
  5961. end;
  5962. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5963. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5964. var
  5965. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5966. begin
  5967. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5968. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5969. // write complete buffer
  5970. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5971. // reset buffer
  5972. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5973. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5974. end;
  5975. result := true;
  5976. end;
  5977. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5978. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5979. var
  5980. Idx: Integer;
  5981. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5982. begin
  5983. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5984. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5985. // check for endblock
  5986. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5987. // write endblock
  5988. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5989. // leave
  5990. break;
  5991. end else
  5992. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5993. end;
  5994. end;
  5995. {$ENDIF}
  5996. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5997. {$IF DEFINED(GLB_LAZ_JPEG)}
  5998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5999. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6000. const
  6001. MAGIC_LEN = 2;
  6002. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  6003. var
  6004. intf: TLazIntfImage;
  6005. reader: TFPReaderJPEG;
  6006. StreamPos: Int64;
  6007. magic: String[MAGIC_LEN];
  6008. begin
  6009. result := true;
  6010. StreamPos := aStream.Position;
  6011. SetLength(magic, MAGIC_LEN);
  6012. aStream.Read(magic[1], MAGIC_LEN);
  6013. aStream.Position := StreamPos;
  6014. if (magic <> JPEG_MAGIC) then begin
  6015. result := false;
  6016. exit;
  6017. end;
  6018. reader := TFPReaderJPEG.Create;
  6019. intf := TLazIntfImage.Create(0, 0);
  6020. try try
  6021. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  6022. reader.ImageRead(aStream, intf);
  6023. AssignFromLazIntfImage(intf);
  6024. except
  6025. result := false;
  6026. aStream.Position := StreamPos;
  6027. exit;
  6028. end;
  6029. finally
  6030. reader.Free;
  6031. intf.Free;
  6032. end;
  6033. end;
  6034. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  6035. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6036. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6037. var
  6038. Surface: PSDL_Surface;
  6039. RWops: PSDL_RWops;
  6040. begin
  6041. result := false;
  6042. RWops := glBitmapCreateRWops(aStream);
  6043. try
  6044. if IMG_isJPG(RWops) > 0 then begin
  6045. Surface := IMG_LoadJPG_RW(RWops);
  6046. try
  6047. AssignFromSurface(Surface);
  6048. result := true;
  6049. finally
  6050. SDL_FreeSurface(Surface);
  6051. end;
  6052. end;
  6053. finally
  6054. SDL_FreeRW(RWops);
  6055. end;
  6056. end;
  6057. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  6058. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6059. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6060. var
  6061. StreamPos: Int64;
  6062. Temp: array[0..1]of Byte;
  6063. jpeg: jpeg_decompress_struct;
  6064. jpeg_err: jpeg_error_mgr;
  6065. IntFormat: TglBitmapFormat;
  6066. pImage: pByte;
  6067. TempHeight, TempWidth: Integer;
  6068. pTemp: pByte;
  6069. Row: Integer;
  6070. FormatDesc: TFormatDescriptor;
  6071. begin
  6072. result := false;
  6073. if not init_libJPEG then
  6074. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  6075. try
  6076. // reading first two bytes to test file and set cursor back to begin
  6077. StreamPos := aStream.Position;
  6078. aStream.Read({%H-}Temp[0], 2);
  6079. aStream.Position := StreamPos;
  6080. // if Bitmap then read file.
  6081. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  6082. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  6083. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  6084. // error managment
  6085. jpeg.err := jpeg_std_error(@jpeg_err);
  6086. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  6087. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  6088. // decompression struct
  6089. jpeg_create_decompress(@jpeg);
  6090. // allocation space for streaming methods
  6091. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  6092. // seeting up custom functions
  6093. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  6094. pub.init_source := glBitmap_libJPEG_init_source;
  6095. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  6096. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  6097. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  6098. pub.term_source := glBitmap_libJPEG_term_source;
  6099. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  6100. pub.next_input_byte := nil; // until buffer loaded
  6101. SrcStream := aStream;
  6102. end;
  6103. // set global decoding state
  6104. jpeg.global_state := DSTATE_START;
  6105. // read header of jpeg
  6106. jpeg_read_header(@jpeg, false);
  6107. // setting output parameter
  6108. case jpeg.jpeg_color_space of
  6109. JCS_GRAYSCALE:
  6110. begin
  6111. jpeg.out_color_space := JCS_GRAYSCALE;
  6112. IntFormat := tfLuminance8;
  6113. end;
  6114. else
  6115. jpeg.out_color_space := JCS_RGB;
  6116. IntFormat := tfRGB8;
  6117. end;
  6118. // reading image
  6119. jpeg_start_decompress(@jpeg);
  6120. TempHeight := jpeg.output_height;
  6121. TempWidth := jpeg.output_width;
  6122. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6123. // creating new image
  6124. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  6125. try
  6126. pTemp := pImage;
  6127. for Row := 0 to TempHeight -1 do begin
  6128. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  6129. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  6130. end;
  6131. // finish decompression
  6132. jpeg_finish_decompress(@jpeg);
  6133. // destroy decompression
  6134. jpeg_destroy_decompress(@jpeg);
  6135. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  6136. result := true;
  6137. except
  6138. if Assigned(pImage) then
  6139. FreeMem(pImage);
  6140. raise;
  6141. end;
  6142. end;
  6143. finally
  6144. quit_libJPEG;
  6145. end;
  6146. end;
  6147. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  6148. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6149. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6150. var
  6151. bmp: TBitmap;
  6152. jpg: TJPEGImage;
  6153. StreamPos: Int64;
  6154. Temp: array[0..1]of Byte;
  6155. begin
  6156. result := false;
  6157. // reading first two bytes to test file and set cursor back to begin
  6158. StreamPos := aStream.Position;
  6159. aStream.Read(Temp[0], 2);
  6160. aStream.Position := StreamPos;
  6161. // if Bitmap then read file.
  6162. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  6163. bmp := TBitmap.Create;
  6164. try
  6165. jpg := TJPEGImage.Create;
  6166. try
  6167. jpg.LoadFromStream(aStream);
  6168. bmp.Assign(jpg);
  6169. result := AssignFromBitmap(bmp);
  6170. finally
  6171. jpg.Free;
  6172. end;
  6173. finally
  6174. bmp.Free;
  6175. end;
  6176. end;
  6177. end;
  6178. {$IFEND}
  6179. {$ENDIF}
  6180. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  6181. {$IF DEFINED(GLB_LAZ_JPEG)}
  6182. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6183. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6184. var
  6185. jpeg: TJPEGImage;
  6186. intf: TLazIntfImage;
  6187. raw: TRawImage;
  6188. begin
  6189. jpeg := TJPEGImage.Create;
  6190. intf := TLazIntfImage.Create(0, 0);
  6191. try
  6192. if not AssignToLazIntfImage(intf) then
  6193. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  6194. intf.GetRawImage(raw);
  6195. jpeg.LoadFromRawImage(raw, false);
  6196. jpeg.SaveToStream(aStream);
  6197. finally
  6198. intf.Free;
  6199. jpeg.Free;
  6200. end;
  6201. end;
  6202. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  6203. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6204. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6205. var
  6206. jpeg: jpeg_compress_struct;
  6207. jpeg_err: jpeg_error_mgr;
  6208. Row: Integer;
  6209. pTemp, pTemp2: pByte;
  6210. procedure CopyRow(pDest, pSource: pByte);
  6211. var
  6212. X: Integer;
  6213. begin
  6214. for X := 0 to Width - 1 do begin
  6215. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  6216. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  6217. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  6218. Inc(pDest, 3);
  6219. Inc(pSource, 3);
  6220. end;
  6221. end;
  6222. begin
  6223. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6224. raise EglBitmapUnsupportedFormat.Create(Format);
  6225. if not init_libJPEG then
  6226. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  6227. try
  6228. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  6229. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  6230. // error managment
  6231. jpeg.err := jpeg_std_error(@jpeg_err);
  6232. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  6233. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  6234. // compression struct
  6235. jpeg_create_compress(@jpeg);
  6236. // allocation space for streaming methods
  6237. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  6238. // seeting up custom functions
  6239. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  6240. pub.init_destination := glBitmap_libJPEG_init_destination;
  6241. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  6242. pub.term_destination := glBitmap_libJPEG_term_destination;
  6243. pub.next_output_byte := @DestBuffer[1];
  6244. pub.free_in_buffer := Length(DestBuffer);
  6245. DestStream := aStream;
  6246. end;
  6247. // very important state
  6248. jpeg.global_state := CSTATE_START;
  6249. jpeg.image_width := Width;
  6250. jpeg.image_height := Height;
  6251. case Format of
  6252. tfAlpha8, tfLuminance8: begin
  6253. jpeg.input_components := 1;
  6254. jpeg.in_color_space := JCS_GRAYSCALE;
  6255. end;
  6256. tfRGB8, tfBGR8: begin
  6257. jpeg.input_components := 3;
  6258. jpeg.in_color_space := JCS_RGB;
  6259. end;
  6260. end;
  6261. jpeg_set_defaults(@jpeg);
  6262. jpeg_set_quality(@jpeg, 95, true);
  6263. jpeg_start_compress(@jpeg, true);
  6264. pTemp := Data;
  6265. if Format = tfBGR8 then
  6266. GetMem(pTemp2, fRowSize)
  6267. else
  6268. pTemp2 := pTemp;
  6269. try
  6270. for Row := 0 to jpeg.image_height -1 do begin
  6271. // prepare row
  6272. if Format = tfBGR8 then
  6273. CopyRow(pTemp2, pTemp)
  6274. else
  6275. pTemp2 := pTemp;
  6276. // write row
  6277. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  6278. inc(pTemp, fRowSize);
  6279. end;
  6280. finally
  6281. // free memory
  6282. if Format = tfBGR8 then
  6283. FreeMem(pTemp2);
  6284. end;
  6285. jpeg_finish_compress(@jpeg);
  6286. jpeg_destroy_compress(@jpeg);
  6287. finally
  6288. quit_libJPEG;
  6289. end;
  6290. end;
  6291. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  6292. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6293. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6294. var
  6295. Bmp: TBitmap;
  6296. Jpg: TJPEGImage;
  6297. begin
  6298. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6299. raise EglBitmapUnsupportedFormat.Create(Format);
  6300. Bmp := TBitmap.Create;
  6301. try
  6302. Jpg := TJPEGImage.Create;
  6303. try
  6304. AssignToBitmap(Bmp);
  6305. if (Format in [tfAlpha8, tfLuminance8]) then begin
  6306. Jpg.Grayscale := true;
  6307. Jpg.PixelFormat := jf8Bit;
  6308. end;
  6309. Jpg.Assign(Bmp);
  6310. Jpg.SaveToStream(aStream);
  6311. finally
  6312. FreeAndNil(Jpg);
  6313. end;
  6314. finally
  6315. FreeAndNil(Bmp);
  6316. end;
  6317. end;
  6318. {$IFEND}
  6319. {$ENDIF}
  6320. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6321. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6322. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6323. const
  6324. BMP_MAGIC = $4D42;
  6325. BMP_COMP_RGB = 0;
  6326. BMP_COMP_RLE8 = 1;
  6327. BMP_COMP_RLE4 = 2;
  6328. BMP_COMP_BITFIELDS = 3;
  6329. type
  6330. TBMPHeader = packed record
  6331. bfType: Word;
  6332. bfSize: Cardinal;
  6333. bfReserved1: Word;
  6334. bfReserved2: Word;
  6335. bfOffBits: Cardinal;
  6336. end;
  6337. TBMPInfo = packed record
  6338. biSize: Cardinal;
  6339. biWidth: Longint;
  6340. biHeight: Longint;
  6341. biPlanes: Word;
  6342. biBitCount: Word;
  6343. biCompression: Cardinal;
  6344. biSizeImage: Cardinal;
  6345. biXPelsPerMeter: Longint;
  6346. biYPelsPerMeter: Longint;
  6347. biClrUsed: Cardinal;
  6348. biClrImportant: Cardinal;
  6349. end;
  6350. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6351. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  6352. //////////////////////////////////////////////////////////////////////////////////////////////////
  6353. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  6354. begin
  6355. result := tfEmpty;
  6356. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  6357. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  6358. //Read Compression
  6359. case aInfo.biCompression of
  6360. BMP_COMP_RLE4,
  6361. BMP_COMP_RLE8: begin
  6362. raise EglBitmap.Create('RLE compression is not supported');
  6363. end;
  6364. BMP_COMP_BITFIELDS: begin
  6365. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  6366. aStream.Read(aMask.r, SizeOf(aMask.r));
  6367. aStream.Read(aMask.g, SizeOf(aMask.g));
  6368. aStream.Read(aMask.b, SizeOf(aMask.b));
  6369. aStream.Read(aMask.a, SizeOf(aMask.a));
  6370. end else
  6371. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  6372. end;
  6373. end;
  6374. //get suitable format
  6375. case aInfo.biBitCount of
  6376. 8: result := tfLuminance8;
  6377. 16: result := tfX1RGB5;
  6378. 24: result := tfRGB8;
  6379. 32: result := tfXRGB8;
  6380. end;
  6381. end;
  6382. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  6383. var
  6384. i, c: Integer;
  6385. ColorTable: TbmpColorTable;
  6386. begin
  6387. result := nil;
  6388. if (aInfo.biBitCount >= 16) then
  6389. exit;
  6390. aFormat := tfLuminance8;
  6391. c := aInfo.biClrUsed;
  6392. if (c = 0) then
  6393. c := 1 shl aInfo.biBitCount;
  6394. SetLength(ColorTable, c);
  6395. for i := 0 to c-1 do begin
  6396. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  6397. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  6398. aFormat := tfRGB8;
  6399. end;
  6400. result := TbmpColorTableFormat.Create;
  6401. result.PixelSize := aInfo.biBitCount / 8;
  6402. result.ColorTable := ColorTable;
  6403. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  6404. end;
  6405. //////////////////////////////////////////////////////////////////////////////////////////////////
  6406. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  6407. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  6408. var
  6409. TmpFormat: TglBitmapFormat;
  6410. FormatDesc: TFormatDescriptor;
  6411. begin
  6412. result := nil;
  6413. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  6414. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6415. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  6416. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  6417. aFormat := FormatDesc.Format;
  6418. exit;
  6419. end;
  6420. end;
  6421. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  6422. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  6423. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  6424. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  6425. result := TbmpBitfieldFormat.Create;
  6426. result.PixelSize := aInfo.biBitCount / 8;
  6427. result.RedMask := aMask.r;
  6428. result.GreenMask := aMask.g;
  6429. result.BlueMask := aMask.b;
  6430. result.AlphaMask := aMask.a;
  6431. end;
  6432. end;
  6433. var
  6434. //simple types
  6435. StartPos: Int64;
  6436. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  6437. PaddingBuff: Cardinal;
  6438. LineBuf, ImageData, TmpData: PByte;
  6439. SourceMD, DestMD: Pointer;
  6440. BmpFormat: TglBitmapFormat;
  6441. //records
  6442. Mask: TglBitmapColorRec;
  6443. Header: TBMPHeader;
  6444. Info: TBMPInfo;
  6445. //classes
  6446. SpecialFormat: TFormatDescriptor;
  6447. FormatDesc: TFormatDescriptor;
  6448. //////////////////////////////////////////////////////////////////////////////////////////////////
  6449. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  6450. var
  6451. i: Integer;
  6452. Pixel: TglBitmapPixelData;
  6453. begin
  6454. aStream.Read(aLineBuf^, rbLineSize);
  6455. SpecialFormat.PreparePixel(Pixel);
  6456. for i := 0 to Info.biWidth-1 do begin
  6457. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  6458. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  6459. FormatDesc.Map(Pixel, aData, DestMD);
  6460. end;
  6461. end;
  6462. begin
  6463. result := false;
  6464. BmpFormat := tfEmpty;
  6465. SpecialFormat := nil;
  6466. LineBuf := nil;
  6467. SourceMD := nil;
  6468. DestMD := nil;
  6469. // Header
  6470. StartPos := aStream.Position;
  6471. aStream.Read(Header{%H-}, SizeOf(Header));
  6472. if Header.bfType = BMP_MAGIC then begin
  6473. try try
  6474. BmpFormat := ReadInfo(Info, Mask);
  6475. SpecialFormat := ReadColorTable(BmpFormat, Info);
  6476. if not Assigned(SpecialFormat) then
  6477. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  6478. aStream.Position := StartPos + Header.bfOffBits;
  6479. if (BmpFormat <> tfEmpty) then begin
  6480. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  6481. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  6482. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  6483. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  6484. //get Memory
  6485. DestMD := FormatDesc.CreateMappingData;
  6486. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  6487. GetMem(ImageData, ImageSize);
  6488. if Assigned(SpecialFormat) then begin
  6489. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  6490. SourceMD := SpecialFormat.CreateMappingData;
  6491. end;
  6492. //read Data
  6493. try try
  6494. FillChar(ImageData^, ImageSize, $FF);
  6495. TmpData := ImageData;
  6496. if (Info.biHeight > 0) then
  6497. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  6498. for i := 0 to Abs(Info.biHeight)-1 do begin
  6499. if Assigned(SpecialFormat) then
  6500. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  6501. else
  6502. aStream.Read(TmpData^, wbLineSize); //else only read data
  6503. if (Info.biHeight > 0) then
  6504. dec(TmpData, wbLineSize)
  6505. else
  6506. inc(TmpData, wbLineSize);
  6507. aStream.Read(PaddingBuff{%H-}, Padding);
  6508. end;
  6509. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6510. result := true;
  6511. finally
  6512. if Assigned(LineBuf) then
  6513. FreeMem(LineBuf);
  6514. if Assigned(SourceMD) then
  6515. SpecialFormat.FreeMappingData(SourceMD);
  6516. FormatDesc.FreeMappingData(DestMD);
  6517. end;
  6518. except
  6519. if Assigned(ImageData) then
  6520. FreeMem(ImageData);
  6521. raise;
  6522. end;
  6523. end else
  6524. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6525. except
  6526. aStream.Position := StartPos;
  6527. raise;
  6528. end;
  6529. finally
  6530. FreeAndNil(SpecialFormat);
  6531. end;
  6532. end
  6533. else aStream.Position := StartPos;
  6534. end;
  6535. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6536. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6537. var
  6538. Header: TBMPHeader;
  6539. Info: TBMPInfo;
  6540. Converter: TFormatDescriptor;
  6541. FormatDesc: TFormatDescriptor;
  6542. SourceFD, DestFD: Pointer;
  6543. pData, srcData, dstData, ConvertBuffer: pByte;
  6544. Pixel: TglBitmapPixelData;
  6545. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6546. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6547. PaddingBuff: Cardinal;
  6548. function GetLineWidth : Integer;
  6549. begin
  6550. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6551. end;
  6552. begin
  6553. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6554. raise EglBitmapUnsupportedFormat.Create(Format);
  6555. Converter := nil;
  6556. FormatDesc := TFormatDescriptor.Get(Format);
  6557. ImageSize := FormatDesc.GetSize(Dimension);
  6558. FillChar(Header{%H-}, SizeOf(Header), 0);
  6559. Header.bfType := BMP_MAGIC;
  6560. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6561. Header.bfReserved1 := 0;
  6562. Header.bfReserved2 := 0;
  6563. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6564. FillChar(Info{%H-}, SizeOf(Info), 0);
  6565. Info.biSize := SizeOf(Info);
  6566. Info.biWidth := Width;
  6567. Info.biHeight := Height;
  6568. Info.biPlanes := 1;
  6569. Info.biCompression := BMP_COMP_RGB;
  6570. Info.biSizeImage := ImageSize;
  6571. try
  6572. case Format of
  6573. tfLuminance4: begin
  6574. Info.biBitCount := 4;
  6575. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  6576. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  6577. Converter := TbmpColorTableFormat.Create;
  6578. with (Converter as TbmpColorTableFormat) do begin
  6579. PixelSize := 0.5;
  6580. Format := Format;
  6581. Range := glBitmapColorRec($F, $F, $F, $0);
  6582. CreateColorTable;
  6583. end;
  6584. end;
  6585. tfR3G3B2, tfLuminance8: begin
  6586. Info.biBitCount := 8;
  6587. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6588. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6589. Converter := TbmpColorTableFormat.Create;
  6590. with (Converter as TbmpColorTableFormat) do begin
  6591. PixelSize := 1;
  6592. Format := Format;
  6593. if (Format = tfR3G3B2) then begin
  6594. Range := glBitmapColorRec($7, $7, $3, $0);
  6595. Shift := glBitmapShiftRec(0, 3, 6, 0);
  6596. end else
  6597. Range := glBitmapColorRec($FF, $FF, $FF, $0);
  6598. CreateColorTable;
  6599. end;
  6600. end;
  6601. tfRGBX4, tfXRGB4, tfRGB5X1, tfX1RGB5, tfR5G6B5, tfRGB5A1, tfA1RGB5, tfRGBA4, tfARGB4,
  6602. tfBGRX4, tfXBGR4, tfBGR5X1, tfX1BGR5, tfB5G6R5, tfBGR5A1, tfA1BGR5, tfBGRA4, tfABGR4: begin
  6603. Info.biBitCount := 16;
  6604. Info.biCompression := BMP_COMP_BITFIELDS;
  6605. end;
  6606. tfBGR8, tfRGB8: begin
  6607. Info.biBitCount := 24;
  6608. if (Format = tfRGB8) then
  6609. Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6610. end;
  6611. tfRGB10X2, tfX2RGB10, tfRGB10A2, tfA2RGB10, tfRGBA8, tfARGB8,
  6612. tfBGR10X2, tfX2BGR10, tfBGR10A2, tfA2BGR10, tfBGRA8, tfABGR8: begin
  6613. Info.biBitCount := 32;
  6614. Info.biCompression := BMP_COMP_BITFIELDS;
  6615. end;
  6616. else
  6617. raise EglBitmapUnsupportedFormat.Create(Format);
  6618. end;
  6619. Info.biXPelsPerMeter := 2835;
  6620. Info.biYPelsPerMeter := 2835;
  6621. // prepare bitmasks
  6622. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6623. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6624. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6625. RedMask := FormatDesc.RedMask;
  6626. GreenMask := FormatDesc.GreenMask;
  6627. BlueMask := FormatDesc.BlueMask;
  6628. AlphaMask := FormatDesc.AlphaMask;
  6629. end;
  6630. // headers
  6631. aStream.Write(Header, SizeOf(Header));
  6632. aStream.Write(Info, SizeOf(Info));
  6633. // colortable
  6634. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6635. with (Converter as TbmpColorTableFormat) do
  6636. aStream.Write(ColorTable[0].b,
  6637. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6638. // bitmasks
  6639. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6640. aStream.Write(RedMask, SizeOf(Cardinal));
  6641. aStream.Write(GreenMask, SizeOf(Cardinal));
  6642. aStream.Write(BlueMask, SizeOf(Cardinal));
  6643. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6644. end;
  6645. // image data
  6646. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  6647. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6648. Padding := GetLineWidth - wbLineSize;
  6649. PaddingBuff := 0;
  6650. pData := Data;
  6651. inc(pData, (Height-1) * rbLineSize);
  6652. // prepare row buffer. But only for RGB because RGBA supports color masks
  6653. // so it's possible to change color within the image.
  6654. if Assigned(Converter) then begin
  6655. FormatDesc.PreparePixel(Pixel);
  6656. GetMem(ConvertBuffer, wbLineSize);
  6657. SourceFD := FormatDesc.CreateMappingData;
  6658. DestFD := Converter.CreateMappingData;
  6659. end else
  6660. ConvertBuffer := nil;
  6661. try
  6662. for LineIdx := 0 to Height - 1 do begin
  6663. // preparing row
  6664. if Assigned(Converter) then begin
  6665. srcData := pData;
  6666. dstData := ConvertBuffer;
  6667. for PixelIdx := 0 to Info.biWidth-1 do begin
  6668. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6669. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6670. Converter.Map(Pixel, dstData, DestFD);
  6671. end;
  6672. aStream.Write(ConvertBuffer^, wbLineSize);
  6673. end else begin
  6674. aStream.Write(pData^, rbLineSize);
  6675. end;
  6676. dec(pData, rbLineSize);
  6677. if (Padding > 0) then
  6678. aStream.Write(PaddingBuff, Padding);
  6679. end;
  6680. finally
  6681. // destroy row buffer
  6682. if Assigned(ConvertBuffer) then begin
  6683. FormatDesc.FreeMappingData(SourceFD);
  6684. Converter.FreeMappingData(DestFD);
  6685. FreeMem(ConvertBuffer);
  6686. end;
  6687. end;
  6688. finally
  6689. if Assigned(Converter) then
  6690. Converter.Free;
  6691. end;
  6692. end;
  6693. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6694. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6695. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6696. type
  6697. TTGAHeader = packed record
  6698. ImageID: Byte;
  6699. ColorMapType: Byte;
  6700. ImageType: Byte;
  6701. //ColorMapSpec: Array[0..4] of Byte;
  6702. ColorMapStart: Word;
  6703. ColorMapLength: Word;
  6704. ColorMapEntrySize: Byte;
  6705. OrigX: Word;
  6706. OrigY: Word;
  6707. Width: Word;
  6708. Height: Word;
  6709. Bpp: Byte;
  6710. ImageDesc: Byte;
  6711. end;
  6712. const
  6713. TGA_UNCOMPRESSED_RGB = 2;
  6714. TGA_UNCOMPRESSED_GRAY = 3;
  6715. TGA_COMPRESSED_RGB = 10;
  6716. TGA_COMPRESSED_GRAY = 11;
  6717. TGA_NONE_COLOR_TABLE = 0;
  6718. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6719. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6720. var
  6721. Header: TTGAHeader;
  6722. ImageData: System.PByte;
  6723. StartPosition: Int64;
  6724. PixelSize, LineSize: Integer;
  6725. tgaFormat: TglBitmapFormat;
  6726. FormatDesc: TFormatDescriptor;
  6727. Counter: packed record
  6728. X, Y: packed record
  6729. low, high, dir: Integer;
  6730. end;
  6731. end;
  6732. const
  6733. CACHE_SIZE = $4000;
  6734. ////////////////////////////////////////////////////////////////////////////////////////
  6735. procedure ReadUncompressed;
  6736. var
  6737. i, j: Integer;
  6738. buf, tmp1, tmp2: System.PByte;
  6739. begin
  6740. buf := nil;
  6741. if (Counter.X.dir < 0) then
  6742. GetMem(buf, LineSize);
  6743. try
  6744. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6745. tmp1 := ImageData;
  6746. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6747. if (Counter.X.dir < 0) then begin //flip X
  6748. aStream.Read(buf^, LineSize);
  6749. tmp2 := buf;
  6750. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6751. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6752. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6753. tmp1^ := tmp2^;
  6754. inc(tmp1);
  6755. inc(tmp2);
  6756. end;
  6757. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6758. end;
  6759. end else
  6760. aStream.Read(tmp1^, LineSize);
  6761. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6762. end;
  6763. finally
  6764. if Assigned(buf) then
  6765. FreeMem(buf);
  6766. end;
  6767. end;
  6768. ////////////////////////////////////////////////////////////////////////////////////////
  6769. procedure ReadCompressed;
  6770. /////////////////////////////////////////////////////////////////
  6771. var
  6772. TmpData: System.PByte;
  6773. LinePixelsRead: Integer;
  6774. procedure CheckLine;
  6775. begin
  6776. if (LinePixelsRead >= Header.Width) then begin
  6777. LinePixelsRead := 0;
  6778. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6779. TmpData := ImageData;
  6780. inc(TmpData, Counter.Y.low * LineSize); //set line
  6781. if (Counter.X.dir < 0) then //if x flipped then
  6782. inc(TmpData, LineSize - PixelSize); //set last pixel
  6783. end;
  6784. end;
  6785. /////////////////////////////////////////////////////////////////
  6786. var
  6787. Cache: PByte;
  6788. CacheSize, CachePos: Integer;
  6789. procedure CachedRead(out Buffer; Count: Integer);
  6790. var
  6791. BytesRead: Integer;
  6792. begin
  6793. if (CachePos + Count > CacheSize) then begin
  6794. //if buffer overflow save non read bytes
  6795. BytesRead := 0;
  6796. if (CacheSize - CachePos > 0) then begin
  6797. BytesRead := CacheSize - CachePos;
  6798. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6799. inc(CachePos, BytesRead);
  6800. end;
  6801. //load cache from file
  6802. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6803. aStream.Read(Cache^, CacheSize);
  6804. CachePos := 0;
  6805. //read rest of requested bytes
  6806. if (Count - BytesRead > 0) then begin
  6807. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6808. inc(CachePos, Count - BytesRead);
  6809. end;
  6810. end else begin
  6811. //if no buffer overflow just read the data
  6812. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6813. inc(CachePos, Count);
  6814. end;
  6815. end;
  6816. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6817. begin
  6818. case PixelSize of
  6819. 1: begin
  6820. aBuffer^ := aData^;
  6821. inc(aBuffer, Counter.X.dir);
  6822. end;
  6823. 2: begin
  6824. PWord(aBuffer)^ := PWord(aData)^;
  6825. inc(aBuffer, 2 * Counter.X.dir);
  6826. end;
  6827. 3: begin
  6828. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6829. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6830. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6831. inc(aBuffer, 3 * Counter.X.dir);
  6832. end;
  6833. 4: begin
  6834. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6835. inc(aBuffer, 4 * Counter.X.dir);
  6836. end;
  6837. end;
  6838. end;
  6839. var
  6840. TotalPixelsToRead, TotalPixelsRead: Integer;
  6841. Temp: Byte;
  6842. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6843. PixelRepeat: Boolean;
  6844. PixelsToRead, PixelCount: Integer;
  6845. begin
  6846. CacheSize := 0;
  6847. CachePos := 0;
  6848. TotalPixelsToRead := Header.Width * Header.Height;
  6849. TotalPixelsRead := 0;
  6850. LinePixelsRead := 0;
  6851. GetMem(Cache, CACHE_SIZE);
  6852. try
  6853. TmpData := ImageData;
  6854. inc(TmpData, Counter.Y.low * LineSize); //set line
  6855. if (Counter.X.dir < 0) then //if x flipped then
  6856. inc(TmpData, LineSize - PixelSize); //set last pixel
  6857. repeat
  6858. //read CommandByte
  6859. CachedRead(Temp, 1);
  6860. PixelRepeat := (Temp and $80) > 0;
  6861. PixelsToRead := (Temp and $7F) + 1;
  6862. inc(TotalPixelsRead, PixelsToRead);
  6863. if PixelRepeat then
  6864. CachedRead(buf[0], PixelSize);
  6865. while (PixelsToRead > 0) do begin
  6866. CheckLine;
  6867. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6868. while (PixelCount > 0) do begin
  6869. if not PixelRepeat then
  6870. CachedRead(buf[0], PixelSize);
  6871. PixelToBuffer(@buf[0], TmpData);
  6872. inc(LinePixelsRead);
  6873. dec(PixelsToRead);
  6874. dec(PixelCount);
  6875. end;
  6876. end;
  6877. until (TotalPixelsRead >= TotalPixelsToRead);
  6878. finally
  6879. FreeMem(Cache);
  6880. end;
  6881. end;
  6882. function IsGrayFormat: Boolean;
  6883. begin
  6884. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6885. end;
  6886. begin
  6887. result := false;
  6888. // reading header to test file and set cursor back to begin
  6889. StartPosition := aStream.Position;
  6890. aStream.Read(Header{%H-}, SizeOf(Header));
  6891. // no colormapped files
  6892. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6893. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6894. begin
  6895. try
  6896. if Header.ImageID <> 0 then // skip image ID
  6897. aStream.Position := aStream.Position + Header.ImageID;
  6898. tgaFormat := tfEmpty;
  6899. case Header.Bpp of
  6900. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6901. 0: tgaFormat := tfLuminance8;
  6902. 8: tgaFormat := tfAlpha8;
  6903. end;
  6904. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6905. 0: tgaFormat := tfLuminance16;
  6906. 8: tgaFormat := tfLuminance8Alpha8;
  6907. end else case (Header.ImageDesc and $F) of
  6908. 0: tgaFormat := tfX1RGB5;
  6909. 1: tgaFormat := tfA1RGB5;
  6910. 4: tgaFormat := tfARGB4;
  6911. end;
  6912. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6913. 0: tgaFormat := tfRGB8;
  6914. end;
  6915. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6916. 2: tgaFormat := tfA2RGB10;
  6917. 8: tgaFormat := tfARGB8;
  6918. end;
  6919. end;
  6920. if (tgaFormat = tfEmpty) then
  6921. raise EglBitmap.Create('LoadTga - unsupported format');
  6922. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6923. PixelSize := FormatDesc.GetSize(1, 1);
  6924. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6925. GetMem(ImageData, LineSize * Header.Height);
  6926. try
  6927. //column direction
  6928. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6929. Counter.X.low := Header.Height-1;;
  6930. Counter.X.high := 0;
  6931. Counter.X.dir := -1;
  6932. end else begin
  6933. Counter.X.low := 0;
  6934. Counter.X.high := Header.Height-1;
  6935. Counter.X.dir := 1;
  6936. end;
  6937. // Row direction
  6938. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6939. Counter.Y.low := 0;
  6940. Counter.Y.high := Header.Height-1;
  6941. Counter.Y.dir := 1;
  6942. end else begin
  6943. Counter.Y.low := Header.Height-1;;
  6944. Counter.Y.high := 0;
  6945. Counter.Y.dir := -1;
  6946. end;
  6947. // Read Image
  6948. case Header.ImageType of
  6949. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6950. ReadUncompressed;
  6951. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6952. ReadCompressed;
  6953. end;
  6954. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6955. result := true;
  6956. except
  6957. if Assigned(ImageData) then
  6958. FreeMem(ImageData);
  6959. raise;
  6960. end;
  6961. finally
  6962. aStream.Position := StartPosition;
  6963. end;
  6964. end
  6965. else aStream.Position := StartPosition;
  6966. end;
  6967. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6968. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6969. var
  6970. Header: TTGAHeader;
  6971. LineSize, Size, x, y: Integer;
  6972. Pixel: TglBitmapPixelData;
  6973. LineBuf, SourceData, DestData: PByte;
  6974. SourceMD, DestMD: Pointer;
  6975. FormatDesc: TFormatDescriptor;
  6976. Converter: TFormatDescriptor;
  6977. begin
  6978. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6979. raise EglBitmapUnsupportedFormat.Create(Format);
  6980. //prepare header
  6981. FillChar(Header{%H-}, SizeOf(Header), 0);
  6982. //set ImageType
  6983. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6984. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6985. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6986. else
  6987. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6988. //set BitsPerPixel
  6989. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6990. Header.Bpp := 8
  6991. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6992. tfRGB5X1, tfBGR5X1, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6993. Header.Bpp := 16
  6994. else if (Format in [tfBGR8, tfRGB8]) then
  6995. Header.Bpp := 24
  6996. else
  6997. Header.Bpp := 32;
  6998. //set AlphaBitCount
  6999. case Format of
  7000. tfRGB5A1, tfBGR5A1:
  7001. Header.ImageDesc := 1 and $F;
  7002. tfRGB10A2, tfBGR10A2:
  7003. Header.ImageDesc := 2 and $F;
  7004. tfRGBA4, tfBGRA4:
  7005. Header.ImageDesc := 4 and $F;
  7006. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  7007. Header.ImageDesc := 8 and $F;
  7008. end;
  7009. Header.Width := Width;
  7010. Header.Height := Height;
  7011. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  7012. aStream.Write(Header, SizeOf(Header));
  7013. // convert RGB(A) to BGR(A)
  7014. Converter := nil;
  7015. FormatDesc := TFormatDescriptor.Get(Format);
  7016. Size := FormatDesc.GetSize(Dimension);
  7017. if Format in [tfRGB5X1, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  7018. if (FormatDesc.RGBInverted = tfEmpty) then
  7019. raise EglBitmap.Create('inverted RGB format is empty');
  7020. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  7021. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  7022. (Converter.PixelSize <> FormatDesc.PixelSize) then
  7023. raise EglBitmap.Create('invalid inverted RGB format');
  7024. end;
  7025. if Assigned(Converter) then begin
  7026. LineSize := FormatDesc.GetSize(Width, 1);
  7027. GetMem(LineBuf, LineSize);
  7028. SourceMD := FormatDesc.CreateMappingData;
  7029. DestMD := Converter.CreateMappingData;
  7030. try
  7031. SourceData := Data;
  7032. for y := 0 to Height-1 do begin
  7033. DestData := LineBuf;
  7034. for x := 0 to Width-1 do begin
  7035. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  7036. Converter.Map(Pixel, DestData, DestMD);
  7037. end;
  7038. aStream.Write(LineBuf^, LineSize);
  7039. end;
  7040. finally
  7041. FreeMem(LineBuf);
  7042. FormatDesc.FreeMappingData(SourceMD);
  7043. FormatDesc.FreeMappingData(DestMD);
  7044. end;
  7045. end else
  7046. aStream.Write(Data^, Size);
  7047. end;
  7048. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7049. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7051. const
  7052. DDS_MAGIC: Cardinal = $20534444;
  7053. // DDS_header.dwFlags
  7054. DDSD_CAPS = $00000001;
  7055. DDSD_HEIGHT = $00000002;
  7056. DDSD_WIDTH = $00000004;
  7057. DDSD_PIXELFORMAT = $00001000;
  7058. // DDS_header.sPixelFormat.dwFlags
  7059. DDPF_ALPHAPIXELS = $00000001;
  7060. DDPF_ALPHA = $00000002;
  7061. DDPF_FOURCC = $00000004;
  7062. DDPF_RGB = $00000040;
  7063. DDPF_LUMINANCE = $00020000;
  7064. // DDS_header.sCaps.dwCaps1
  7065. DDSCAPS_TEXTURE = $00001000;
  7066. // DDS_header.sCaps.dwCaps2
  7067. DDSCAPS2_CUBEMAP = $00000200;
  7068. D3DFMT_DXT1 = $31545844;
  7069. D3DFMT_DXT3 = $33545844;
  7070. D3DFMT_DXT5 = $35545844;
  7071. type
  7072. TDDSPixelFormat = packed record
  7073. dwSize: Cardinal;
  7074. dwFlags: Cardinal;
  7075. dwFourCC: Cardinal;
  7076. dwRGBBitCount: Cardinal;
  7077. dwRBitMask: Cardinal;
  7078. dwGBitMask: Cardinal;
  7079. dwBBitMask: Cardinal;
  7080. dwABitMask: Cardinal;
  7081. end;
  7082. TDDSCaps = packed record
  7083. dwCaps1: Cardinal;
  7084. dwCaps2: Cardinal;
  7085. dwDDSX: Cardinal;
  7086. dwReserved: Cardinal;
  7087. end;
  7088. TDDSHeader = packed record
  7089. dwSize: Cardinal;
  7090. dwFlags: Cardinal;
  7091. dwHeight: Cardinal;
  7092. dwWidth: Cardinal;
  7093. dwPitchOrLinearSize: Cardinal;
  7094. dwDepth: Cardinal;
  7095. dwMipMapCount: Cardinal;
  7096. dwReserved: array[0..10] of Cardinal;
  7097. PixelFormat: TDDSPixelFormat;
  7098. Caps: TDDSCaps;
  7099. dwReserved2: Cardinal;
  7100. end;
  7101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7102. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  7103. var
  7104. Header: TDDSHeader;
  7105. Converter: TbmpBitfieldFormat;
  7106. function GetDDSFormat: TglBitmapFormat;
  7107. var
  7108. fd: TFormatDescriptor;
  7109. i: Integer;
  7110. Range: TglBitmapColorRec;
  7111. match: Boolean;
  7112. begin
  7113. result := tfEmpty;
  7114. with Header.PixelFormat do begin
  7115. // Compresses
  7116. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  7117. case Header.PixelFormat.dwFourCC of
  7118. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  7119. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  7120. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  7121. end;
  7122. end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  7123. // prepare masks
  7124. if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
  7125. Range.r := dwRBitMask;
  7126. Range.g := dwGBitMask;
  7127. Range.b := dwBBitMask;
  7128. end else begin
  7129. Range.r := dwRBitMask;
  7130. Range.g := dwRBitMask;
  7131. Range.b := dwRBitMask;
  7132. end;
  7133. Range.a := dwABitMask;
  7134. //find matching format
  7135. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  7136. fd := TFormatDescriptor.Get(result);
  7137. if fd.MaskMatch(Range.r, Range.g, Range.b, Range.a) and
  7138. (8 * fd.PixelSize = dwRGBBitCount) then
  7139. exit;
  7140. end;
  7141. //find format with same Range
  7142. for i := 0 to 3 do begin
  7143. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  7144. Range.arr[i] := Range.arr[i] shr 1;
  7145. end;
  7146. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  7147. fd := TFormatDescriptor.Get(result);
  7148. match := true;
  7149. for i := 0 to 3 do
  7150. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  7151. match := false;
  7152. break;
  7153. end;
  7154. if match then
  7155. break;
  7156. end;
  7157. //no format with same range found -> use default
  7158. if (result = tfEmpty) then begin
  7159. if (dwABitMask > 0) then
  7160. result := tfRGBA8
  7161. else
  7162. result := tfRGB8;
  7163. end;
  7164. Converter := TbmpBitfieldFormat.Create;
  7165. Converter.RedMask := dwRBitMask;
  7166. Converter.GreenMask := dwGBitMask;
  7167. Converter.BlueMask := dwBBitMask;
  7168. Converter.AlphaMask := dwABitMask;
  7169. Converter.PixelSize := dwRGBBitCount / 8;
  7170. end;
  7171. end;
  7172. end;
  7173. var
  7174. StreamPos: Int64;
  7175. x, y, LineSize, RowSize, Magic: Cardinal;
  7176. NewImage, TmpData, RowData, SrcData: System.PByte;
  7177. SourceMD, DestMD: Pointer;
  7178. Pixel: TglBitmapPixelData;
  7179. ddsFormat: TglBitmapFormat;
  7180. FormatDesc: TFormatDescriptor;
  7181. begin
  7182. result := false;
  7183. Converter := nil;
  7184. StreamPos := aStream.Position;
  7185. // Magic
  7186. aStream.Read(Magic{%H-}, sizeof(Magic));
  7187. if (Magic <> DDS_MAGIC) then begin
  7188. aStream.Position := StreamPos;
  7189. exit;
  7190. end;
  7191. //Header
  7192. aStream.Read(Header{%H-}, sizeof(Header));
  7193. if (Header.dwSize <> SizeOf(Header)) or
  7194. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  7195. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  7196. begin
  7197. aStream.Position := StreamPos;
  7198. exit;
  7199. end;
  7200. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  7201. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  7202. ddsFormat := GetDDSFormat;
  7203. try
  7204. if (ddsFormat = tfEmpty) then
  7205. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  7206. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  7207. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  7208. GetMem(NewImage, Header.dwHeight * LineSize);
  7209. try
  7210. TmpData := NewImage;
  7211. //Converter needed
  7212. if Assigned(Converter) then begin
  7213. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  7214. GetMem(RowData, RowSize);
  7215. SourceMD := Converter.CreateMappingData;
  7216. DestMD := FormatDesc.CreateMappingData;
  7217. try
  7218. for y := 0 to Header.dwHeight-1 do begin
  7219. TmpData := NewImage;
  7220. inc(TmpData, y * LineSize);
  7221. SrcData := RowData;
  7222. aStream.Read(SrcData^, RowSize);
  7223. for x := 0 to Header.dwWidth-1 do begin
  7224. Converter.Unmap(SrcData, Pixel, SourceMD);
  7225. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  7226. FormatDesc.Map(Pixel, TmpData, DestMD);
  7227. end;
  7228. end;
  7229. finally
  7230. Converter.FreeMappingData(SourceMD);
  7231. FormatDesc.FreeMappingData(DestMD);
  7232. FreeMem(RowData);
  7233. end;
  7234. end else
  7235. // Compressed
  7236. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  7237. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  7238. for Y := 0 to Header.dwHeight-1 do begin
  7239. aStream.Read(TmpData^, RowSize);
  7240. Inc(TmpData, LineSize);
  7241. end;
  7242. end else
  7243. // Uncompressed
  7244. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  7245. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  7246. for Y := 0 to Header.dwHeight-1 do begin
  7247. aStream.Read(TmpData^, RowSize);
  7248. Inc(TmpData, LineSize);
  7249. end;
  7250. end else
  7251. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  7252. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  7253. result := true;
  7254. except
  7255. if Assigned(NewImage) then
  7256. FreeMem(NewImage);
  7257. raise;
  7258. end;
  7259. finally
  7260. FreeAndNil(Converter);
  7261. end;
  7262. end;
  7263. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7264. procedure TglBitmap.SaveDDS(const aStream: TStream);
  7265. var
  7266. Header: TDDSHeader;
  7267. FormatDesc: TFormatDescriptor;
  7268. begin
  7269. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  7270. raise EglBitmapUnsupportedFormat.Create(Format);
  7271. FormatDesc := TFormatDescriptor.Get(Format);
  7272. // Generell
  7273. FillChar(Header{%H-}, SizeOf(Header), 0);
  7274. Header.dwSize := SizeOf(Header);
  7275. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  7276. Header.dwWidth := Max(1, Width);
  7277. Header.dwHeight := Max(1, Height);
  7278. // Caps
  7279. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  7280. // Pixelformat
  7281. Header.PixelFormat.dwSize := sizeof(Header);
  7282. if (FormatDesc.IsCompressed) then begin
  7283. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  7284. case Format of
  7285. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  7286. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  7287. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  7288. end;
  7289. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  7290. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  7291. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  7292. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  7293. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  7294. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  7295. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  7296. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  7297. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  7298. end else begin
  7299. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  7300. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  7301. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  7302. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  7303. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  7304. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  7305. end;
  7306. if (FormatDesc.HasAlpha) then
  7307. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  7308. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  7309. aStream.Write(Header, SizeOf(Header));
  7310. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  7311. end;
  7312. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7313. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7314. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7315. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7316. const aWidth: Integer; const aHeight: Integer);
  7317. var
  7318. pTemp: pByte;
  7319. Size: Integer;
  7320. begin
  7321. if (aHeight > 1) then begin
  7322. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  7323. GetMem(pTemp, Size);
  7324. try
  7325. Move(aData^, pTemp^, Size);
  7326. FreeMem(aData);
  7327. aData := nil;
  7328. except
  7329. FreeMem(pTemp);
  7330. raise;
  7331. end;
  7332. end else
  7333. pTemp := aData;
  7334. inherited SetDataPointer(pTemp, aFormat, aWidth);
  7335. end;
  7336. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7337. function TglBitmap1D.FlipHorz: Boolean;
  7338. var
  7339. Col: Integer;
  7340. pTempDest, pDest, pSource: PByte;
  7341. begin
  7342. result := inherited FlipHorz;
  7343. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  7344. pSource := Data;
  7345. GetMem(pDest, fRowSize);
  7346. try
  7347. pTempDest := pDest;
  7348. Inc(pTempDest, fRowSize);
  7349. for Col := 0 to Width-1 do begin
  7350. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  7351. Move(pSource^, pTempDest^, fPixelSize);
  7352. Inc(pSource, fPixelSize);
  7353. end;
  7354. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  7355. result := true;
  7356. except
  7357. if Assigned(pDest) then
  7358. FreeMem(pDest);
  7359. raise;
  7360. end;
  7361. end;
  7362. end;
  7363. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7364. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  7365. var
  7366. FormatDesc: TFormatDescriptor;
  7367. begin
  7368. // Upload data
  7369. FormatDesc := TFormatDescriptor.Get(Format);
  7370. if FormatDesc.IsCompressed then begin
  7371. if not Assigned(glCompressedTexImage1D) then
  7372. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7373. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  7374. end else if aBuildWithGlu then
  7375. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7376. else
  7377. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7378. // Free Data
  7379. if (FreeDataAfterGenTexture) then
  7380. FreeData;
  7381. end;
  7382. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7383. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  7384. var
  7385. BuildWithGlu, TexRec: Boolean;
  7386. TexSize: Integer;
  7387. begin
  7388. if Assigned(Data) then begin
  7389. // Check Texture Size
  7390. if (aTestTextureSize) then begin
  7391. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7392. if (Width > TexSize) then
  7393. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7394. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7395. (Target = GL_TEXTURE_RECTANGLE);
  7396. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7397. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7398. end;
  7399. CreateId;
  7400. SetupParameters(BuildWithGlu);
  7401. UploadData(BuildWithGlu);
  7402. glAreTexturesResident(1, @fID, @fIsResident);
  7403. end;
  7404. end;
  7405. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7406. procedure TglBitmap1D.AfterConstruction;
  7407. begin
  7408. inherited;
  7409. Target := GL_TEXTURE_1D;
  7410. end;
  7411. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7412. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7413. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7414. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  7415. begin
  7416. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  7417. result := fLines[aIndex]
  7418. else
  7419. result := nil;
  7420. end;
  7421. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7422. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7423. const aWidth: Integer; const aHeight: Integer);
  7424. var
  7425. Idx, LineWidth: Integer;
  7426. begin
  7427. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  7428. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  7429. // Assigning Data
  7430. if Assigned(Data) then begin
  7431. SetLength(fLines, GetHeight);
  7432. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  7433. for Idx := 0 to GetHeight-1 do begin
  7434. fLines[Idx] := Data;
  7435. Inc(fLines[Idx], Idx * LineWidth);
  7436. end;
  7437. end
  7438. else SetLength(fLines, 0);
  7439. end else begin
  7440. SetLength(fLines, 0);
  7441. end;
  7442. end;
  7443. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7444. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  7445. var
  7446. FormatDesc: TFormatDescriptor;
  7447. begin
  7448. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7449. FormatDesc := TFormatDescriptor.Get(Format);
  7450. if FormatDesc.IsCompressed then begin
  7451. if not Assigned(glCompressedTexImage2D) then
  7452. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7453. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  7454. end else if aBuildWithGlu then begin
  7455. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  7456. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7457. end else begin
  7458. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  7459. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7460. end;
  7461. // Freigeben
  7462. if (FreeDataAfterGenTexture) then
  7463. FreeData;
  7464. end;
  7465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7466. procedure TglBitmap2D.AfterConstruction;
  7467. begin
  7468. inherited;
  7469. Target := GL_TEXTURE_2D;
  7470. end;
  7471. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7472. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  7473. var
  7474. Temp: pByte;
  7475. Size, w, h: Integer;
  7476. FormatDesc: TFormatDescriptor;
  7477. begin
  7478. FormatDesc := TFormatDescriptor.Get(aFormat);
  7479. if FormatDesc.IsCompressed then
  7480. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7481. w := aRight - aLeft;
  7482. h := aBottom - aTop;
  7483. Size := FormatDesc.GetSize(w, h);
  7484. GetMem(Temp, Size);
  7485. try
  7486. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7487. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7488. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  7489. FlipVert;
  7490. except
  7491. if Assigned(Temp) then
  7492. FreeMem(Temp);
  7493. raise;
  7494. end;
  7495. end;
  7496. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7497. procedure TglBitmap2D.GetDataFromTexture;
  7498. var
  7499. Temp: PByte;
  7500. TempWidth, TempHeight: Integer;
  7501. TempIntFormat: GLint;
  7502. IntFormat: TglBitmapFormat;
  7503. FormatDesc: TFormatDescriptor;
  7504. begin
  7505. Bind;
  7506. // Request Data
  7507. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7508. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7509. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7510. IntFormat := tfEmpty;
  7511. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7512. IntFormat := FormatDesc.Format;
  7513. // Getting data from OpenGL
  7514. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7515. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7516. try
  7517. if FormatDesc.IsCompressed then begin
  7518. if not Assigned(glGetCompressedTexImage) then
  7519. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7520. glGetCompressedTexImage(Target, 0, Temp)
  7521. end else
  7522. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7523. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7524. except
  7525. if Assigned(Temp) then
  7526. FreeMem(Temp);
  7527. raise;
  7528. end;
  7529. end;
  7530. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7531. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7532. var
  7533. BuildWithGlu, PotTex, TexRec: Boolean;
  7534. TexSize: Integer;
  7535. begin
  7536. if Assigned(Data) then begin
  7537. // Check Texture Size
  7538. if (aTestTextureSize) then begin
  7539. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7540. if ((Height > TexSize) or (Width > TexSize)) then
  7541. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7542. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7543. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7544. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7545. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7546. end;
  7547. CreateId;
  7548. SetupParameters(BuildWithGlu);
  7549. UploadData(Target, BuildWithGlu);
  7550. glAreTexturesResident(1, @fID, @fIsResident);
  7551. end;
  7552. end;
  7553. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7554. function TglBitmap2D.FlipHorz: Boolean;
  7555. var
  7556. Col, Row: Integer;
  7557. TempDestData, DestData, SourceData: PByte;
  7558. ImgSize: Integer;
  7559. begin
  7560. result := inherited FlipHorz;
  7561. if Assigned(Data) then begin
  7562. SourceData := Data;
  7563. ImgSize := Height * fRowSize;
  7564. GetMem(DestData, ImgSize);
  7565. try
  7566. TempDestData := DestData;
  7567. Dec(TempDestData, fRowSize + fPixelSize);
  7568. for Row := 0 to Height -1 do begin
  7569. Inc(TempDestData, fRowSize * 2);
  7570. for Col := 0 to Width -1 do begin
  7571. Move(SourceData^, TempDestData^, fPixelSize);
  7572. Inc(SourceData, fPixelSize);
  7573. Dec(TempDestData, fPixelSize);
  7574. end;
  7575. end;
  7576. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7577. result := true;
  7578. except
  7579. if Assigned(DestData) then
  7580. FreeMem(DestData);
  7581. raise;
  7582. end;
  7583. end;
  7584. end;
  7585. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7586. function TglBitmap2D.FlipVert: Boolean;
  7587. var
  7588. Row: Integer;
  7589. TempDestData, DestData, SourceData: PByte;
  7590. begin
  7591. result := inherited FlipVert;
  7592. if Assigned(Data) then begin
  7593. SourceData := Data;
  7594. GetMem(DestData, Height * fRowSize);
  7595. try
  7596. TempDestData := DestData;
  7597. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7598. for Row := 0 to Height -1 do begin
  7599. Move(SourceData^, TempDestData^, fRowSize);
  7600. Dec(TempDestData, fRowSize);
  7601. Inc(SourceData, fRowSize);
  7602. end;
  7603. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7604. result := true;
  7605. except
  7606. if Assigned(DestData) then
  7607. FreeMem(DestData);
  7608. raise;
  7609. end;
  7610. end;
  7611. end;
  7612. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7613. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7614. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7615. type
  7616. TMatrixItem = record
  7617. X, Y: Integer;
  7618. W: Single;
  7619. end;
  7620. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7621. TglBitmapToNormalMapRec = Record
  7622. Scale: Single;
  7623. Heights: array of Single;
  7624. MatrixU : array of TMatrixItem;
  7625. MatrixV : array of TMatrixItem;
  7626. end;
  7627. const
  7628. ONE_OVER_255 = 1 / 255;
  7629. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7630. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7631. var
  7632. Val: Single;
  7633. begin
  7634. with FuncRec do begin
  7635. Val :=
  7636. Source.Data.r * LUMINANCE_WEIGHT_R +
  7637. Source.Data.g * LUMINANCE_WEIGHT_G +
  7638. Source.Data.b * LUMINANCE_WEIGHT_B;
  7639. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7640. end;
  7641. end;
  7642. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7643. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7644. begin
  7645. with FuncRec do
  7646. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7647. end;
  7648. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7649. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7650. type
  7651. TVec = Array[0..2] of Single;
  7652. var
  7653. Idx: Integer;
  7654. du, dv: Double;
  7655. Len: Single;
  7656. Vec: TVec;
  7657. function GetHeight(X, Y: Integer): Single;
  7658. begin
  7659. with FuncRec do begin
  7660. X := Max(0, Min(Size.X -1, X));
  7661. Y := Max(0, Min(Size.Y -1, Y));
  7662. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7663. end;
  7664. end;
  7665. begin
  7666. with FuncRec do begin
  7667. with PglBitmapToNormalMapRec(Args)^ do begin
  7668. du := 0;
  7669. for Idx := Low(MatrixU) to High(MatrixU) do
  7670. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7671. dv := 0;
  7672. for Idx := Low(MatrixU) to High(MatrixU) do
  7673. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7674. Vec[0] := -du * Scale;
  7675. Vec[1] := -dv * Scale;
  7676. Vec[2] := 1;
  7677. end;
  7678. // Normalize
  7679. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7680. if Len <> 0 then begin
  7681. Vec[0] := Vec[0] * Len;
  7682. Vec[1] := Vec[1] * Len;
  7683. Vec[2] := Vec[2] * Len;
  7684. end;
  7685. // Farbe zuweisem
  7686. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7687. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7688. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7689. end;
  7690. end;
  7691. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7692. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7693. var
  7694. Rec: TglBitmapToNormalMapRec;
  7695. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7696. begin
  7697. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7698. Matrix[Index].X := X;
  7699. Matrix[Index].Y := Y;
  7700. Matrix[Index].W := W;
  7701. end;
  7702. end;
  7703. begin
  7704. if TFormatDescriptor.Get(Format).IsCompressed then
  7705. raise EglBitmapUnsupportedFormat.Create(Format);
  7706. if aScale > 100 then
  7707. Rec.Scale := 100
  7708. else if aScale < -100 then
  7709. Rec.Scale := -100
  7710. else
  7711. Rec.Scale := aScale;
  7712. SetLength(Rec.Heights, Width * Height);
  7713. try
  7714. case aFunc of
  7715. nm4Samples: begin
  7716. SetLength(Rec.MatrixU, 2);
  7717. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7718. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7719. SetLength(Rec.MatrixV, 2);
  7720. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7721. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7722. end;
  7723. nmSobel: begin
  7724. SetLength(Rec.MatrixU, 6);
  7725. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7726. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7727. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7728. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7729. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7730. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7731. SetLength(Rec.MatrixV, 6);
  7732. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7733. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7734. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7735. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7736. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7737. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7738. end;
  7739. nm3x3: begin
  7740. SetLength(Rec.MatrixU, 6);
  7741. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7742. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7743. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7744. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7745. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7746. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7747. SetLength(Rec.MatrixV, 6);
  7748. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7749. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7750. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7751. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7752. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7753. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7754. end;
  7755. nm5x5: begin
  7756. SetLength(Rec.MatrixU, 20);
  7757. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7758. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7759. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7760. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7761. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7762. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7763. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7764. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7765. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7766. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7767. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7768. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7769. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7770. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7771. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7772. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7773. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7774. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7775. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7776. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7777. SetLength(Rec.MatrixV, 20);
  7778. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7779. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7780. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7781. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7782. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7783. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7784. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7785. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7786. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7787. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7788. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7789. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7790. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7791. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7792. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7793. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7794. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7795. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7796. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7797. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7798. end;
  7799. end;
  7800. // Daten Sammeln
  7801. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7802. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7803. else
  7804. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7805. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7806. finally
  7807. SetLength(Rec.Heights, 0);
  7808. end;
  7809. end;
  7810. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7811. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7812. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7813. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7814. begin
  7815. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7816. end;
  7817. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7818. procedure TglBitmapCubeMap.AfterConstruction;
  7819. begin
  7820. inherited;
  7821. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7822. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7823. SetWrap;
  7824. Target := GL_TEXTURE_CUBE_MAP;
  7825. fGenMode := GL_REFLECTION_MAP;
  7826. end;
  7827. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7828. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7829. var
  7830. BuildWithGlu: Boolean;
  7831. TexSize: Integer;
  7832. begin
  7833. if (aTestTextureSize) then begin
  7834. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7835. if (Height > TexSize) or (Width > TexSize) then
  7836. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7837. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7838. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7839. end;
  7840. if (ID = 0) then
  7841. CreateID;
  7842. SetupParameters(BuildWithGlu);
  7843. UploadData(aCubeTarget, BuildWithGlu);
  7844. end;
  7845. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7846. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
  7847. begin
  7848. inherited Bind (aEnableTextureUnit);
  7849. if aEnableTexCoordsGen then begin
  7850. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7851. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7852. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7853. glEnable(GL_TEXTURE_GEN_S);
  7854. glEnable(GL_TEXTURE_GEN_T);
  7855. glEnable(GL_TEXTURE_GEN_R);
  7856. end;
  7857. end;
  7858. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7859. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
  7860. begin
  7861. inherited Unbind(aDisableTextureUnit);
  7862. if aDisableTexCoordsGen then begin
  7863. glDisable(GL_TEXTURE_GEN_S);
  7864. glDisable(GL_TEXTURE_GEN_T);
  7865. glDisable(GL_TEXTURE_GEN_R);
  7866. end;
  7867. end;
  7868. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7869. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7870. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7871. type
  7872. TVec = Array[0..2] of Single;
  7873. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7874. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7875. TglBitmapNormalMapRec = record
  7876. HalfSize : Integer;
  7877. Func: TglBitmapNormalMapGetVectorFunc;
  7878. end;
  7879. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7880. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7881. begin
  7882. aVec[0] := aHalfSize;
  7883. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7884. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7885. end;
  7886. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7887. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7888. begin
  7889. aVec[0] := - aHalfSize;
  7890. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7891. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7892. end;
  7893. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7894. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7895. begin
  7896. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7897. aVec[1] := aHalfSize;
  7898. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7899. end;
  7900. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7901. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7902. begin
  7903. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7904. aVec[1] := - aHalfSize;
  7905. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7906. end;
  7907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7908. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7909. begin
  7910. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7911. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7912. aVec[2] := aHalfSize;
  7913. end;
  7914. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7915. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7916. begin
  7917. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7918. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7919. aVec[2] := - aHalfSize;
  7920. end;
  7921. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7922. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7923. var
  7924. i: Integer;
  7925. Vec: TVec;
  7926. Len: Single;
  7927. begin
  7928. with FuncRec do begin
  7929. with PglBitmapNormalMapRec(Args)^ do begin
  7930. Func(Vec, Position, HalfSize);
  7931. // Normalize
  7932. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7933. if Len <> 0 then begin
  7934. Vec[0] := Vec[0] * Len;
  7935. Vec[1] := Vec[1] * Len;
  7936. Vec[2] := Vec[2] * Len;
  7937. end;
  7938. // Scale Vector and AddVectro
  7939. Vec[0] := Vec[0] * 0.5 + 0.5;
  7940. Vec[1] := Vec[1] * 0.5 + 0.5;
  7941. Vec[2] := Vec[2] * 0.5 + 0.5;
  7942. end;
  7943. // Set Color
  7944. for i := 0 to 2 do
  7945. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7946. end;
  7947. end;
  7948. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7949. procedure TglBitmapNormalMap.AfterConstruction;
  7950. begin
  7951. inherited;
  7952. fGenMode := GL_NORMAL_MAP;
  7953. end;
  7954. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7955. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7956. var
  7957. Rec: TglBitmapNormalMapRec;
  7958. SizeRec: TglBitmapPixelPosition;
  7959. begin
  7960. Rec.HalfSize := aSize div 2;
  7961. FreeDataAfterGenTexture := false;
  7962. SizeRec.Fields := [ffX, ffY];
  7963. SizeRec.X := aSize;
  7964. SizeRec.Y := aSize;
  7965. // Positive X
  7966. Rec.Func := glBitmapNormalMapPosX;
  7967. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7968. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7969. // Negative X
  7970. Rec.Func := glBitmapNormalMapNegX;
  7971. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7972. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7973. // Positive Y
  7974. Rec.Func := glBitmapNormalMapPosY;
  7975. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7976. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7977. // Negative Y
  7978. Rec.Func := glBitmapNormalMapNegY;
  7979. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7980. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7981. // Positive Z
  7982. Rec.Func := glBitmapNormalMapPosZ;
  7983. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7984. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7985. // Negative Z
  7986. Rec.Func := glBitmapNormalMapNegZ;
  7987. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7988. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7989. end;
  7990. initialization
  7991. glBitmapSetDefaultFormat (tfEmpty);
  7992. glBitmapSetDefaultMipmap (mmMipmap);
  7993. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7994. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7995. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7996. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7997. glBitmapSetDefaultDeleteTextureOnFree (true);
  7998. TFormatDescriptor.Init;
  7999. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  8000. OpenGLInitialized := false;
  8001. InitOpenGLCS := TCriticalSection.Create;
  8002. {$ENDIF}
  8003. finalization
  8004. TFormatDescriptor.Finalize;
  8005. {$IFDEF GLB_NATIVE_OGL}
  8006. if Assigned(GL_LibHandle) then
  8007. glbFreeLibrary(GL_LibHandle);
  8008. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  8009. if Assigned(GLU_LibHandle) then
  8010. glbFreeLibrary(GLU_LibHandle);
  8011. FreeAndNil(InitOpenGLCS);
  8012. {$ENDIF}
  8013. {$ENDIF}
  8014. end.