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

9097 line
314 KiB

  1. {***********************************************************
  2. glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  3. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  4. modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
  5. ------------------------------------------------------------
  6. The contents of this file are used with permission, subject to
  7. the Mozilla Public License Version 1.1 (the "License"); you may
  8. not use this file except in compliance with the License. You may
  9. obtain a copy of the License at
  10. http://www.mozilla.org/MPL/MPL-1.1.html
  11. ------------------------------------------------------------
  12. Version 3.0.1
  13. ------------------------------------------------------------
  14. History
  15. 20-11-2013
  16. - refactoring of the complete library
  17. 21-03-2010
  18. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  19. then it's your problem if that isn't true. This prevents the unit for incompatibility
  20. with newer versions of Delphi.
  21. - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  22. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  23. 10-08-2008
  24. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  25. - Additional Datapointer for functioninterface now has the name CustomData
  26. 24-07-2008
  27. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  28. - If you load an texture from an file the property Filename will be set to the name of the file
  29. - Three new properties to attach custom data to the Texture objects
  30. - CustomName (free for use string)
  31. - CustomNameW (free for use widestring)
  32. - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  33. 27-05-2008
  34. - RLE TGAs loaded much faster
  35. 26-05-2008
  36. - fixed some problem with reading RLE TGAs.
  37. 21-05-2008
  38. - function clone now only copys data if it's assigned and now it also copies the ID
  39. - it seems that lazarus dont like comments in comments.
  40. 01-05-2008
  41. - It's possible to set the id of the texture
  42. - define GLB_NO_NATIVE_GL deactivated by default
  43. 27-04-2008
  44. - Now supports the following libraries
  45. - SDL and SDL_image
  46. - libPNG
  47. - libJPEG
  48. - Linux compatibillity via free pascal compatibility (delphi sources optional)
  49. - BMPs now loaded manuel
  50. - Large restructuring
  51. - Property DataPtr now has the name Data
  52. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  53. - Unused Depth removed
  54. - Function FreeData to freeing image data added
  55. 24-10-2007
  56. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  57. 15-11-2006
  58. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  59. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  60. - Function ReadOpenGLExtension is now only intern
  61. 29-06-2006
  62. - pngimage now disabled by default like all other versions.
  63. 26-06-2006
  64. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  65. 22-06-2006
  66. - Fixed some Problem with Delphi 5
  67. - Now uses the newest version of pngimage. Makes saving pngs much easier.
  68. 22-03-2006
  69. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  70. 09-03-2006
  71. - Internal Format ifDepth8 added
  72. - function GrabScreen now supports all uncompressed formats
  73. 31-01-2006
  74. - AddAlphaFromglBitmap implemented
  75. 29-12-2005
  76. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  77. 28-12-2005
  78. - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  79. property Width, Height, Depth are still existing and new property Dimension are avail
  80. 11-12-2005
  81. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  82. 19-10-2005
  83. - Added function GrabScreen to class TglBitmap2D
  84. 18-10-2005
  85. - Added support to Save images
  86. - Added function Clone to Clone Instance
  87. 11-10-2005
  88. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  89. Usefull for Future
  90. - Several speed optimizations
  91. 09-10-2005
  92. - Internal structure change. Loading of TGA, PNG and DDS improved.
  93. Data, format and size will now set directly with SetDataPtr.
  94. - AddFunc now works with all Types of Images and Formats
  95. - Some Funtions moved to Baseclass TglBitmap
  96. 06-10-2005
  97. - Added Support to decompress DXT3 and DXT5 compressed Images.
  98. - Added Mapping to convert data from one format into an other.
  99. 05-10-2005
  100. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  101. supported Input format (supported by GetPixel) into any uncompresed Format
  102. - Added Support to decompress DXT1 compressed Images.
  103. - SwapColors replaced by ConvertTo
  104. 04-10-2005
  105. - Added Support for compressed DDSs
  106. - Added new internal formats (DXT1, DXT3, DXT5)
  107. 29-09-2005
  108. - Parameter Components renamed to InternalFormat
  109. 23-09-2005
  110. - Some AllocMem replaced with GetMem (little speed change)
  111. - better exception handling. Better protection from memory leaks.
  112. 22-09-2005
  113. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
  114. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
  115. 07-09-2005
  116. - Added support for Grayscale textures
  117. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
  118. 10-07-2005
  119. - Added support for GL_VERSION_2_0
  120. - Added support for GL_EXT_texture_filter_anisotropic
  121. 04-07-2005
  122. - Function FillWithColor fills the Image with one Color
  123. - Function LoadNormalMap added
  124. 30-06-2005
  125. - ToNormalMap allows to Create an NormalMap from the Alphachannel
  126. - ToNormalMap now supports Sobel (nmSobel) function.
  127. 29-06-2005
  128. - support for RLE Compressed RGB TGAs added
  129. 28-06-2005
  130. - Class TglBitmapNormalMap added to support Normalmap generation
  131. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
  132. 3 Filters are supported. (4 Samples, 3x3 and 5x5)
  133. 16-06-2005
  134. - Method LoadCubeMapClass removed
  135. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
  136. - virtual abstract method GenTexture in class TglBitmap now is protected
  137. 12-06-2005
  138. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
  139. 10-06-2005
  140. - little enhancement for IsPowerOfTwo
  141. - TglBitmap1D.GenTexture now tests NPOT Textures
  142. 06-06-2005
  143. - some little name changes. All properties or function with Texture in name are
  144. now without texture in name. We have allways texture so we dosn't name it.
  145. 03-06-2005
  146. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
  147. TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
  148. 02-06-2005
  149. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
  150. 25-04-2005
  151. - Function Unbind added
  152. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
  153. 21-04-2005
  154. - class TglBitmapCubeMap added (allows to Create Cubemaps)
  155. 29-03-2005
  156. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
  157. To Enable png's use the define pngimage
  158. 22-03-2005
  159. - New Functioninterface added
  160. - Function GetPixel added
  161. 27-11-2004
  162. - Property BuildMipMaps renamed to MipMap
  163. 21-11-2004
  164. - property Name removed.
  165. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
  166. 22-05-2004
  167. - property name added. Only used in glForms!
  168. 26-11-2003
  169. - property FreeDataAfterGenTexture is now available as default (default = true)
  170. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
  171. - function MoveMemory replaced with function Move (little speed change)
  172. - several calculations stored in variables (little speed change)
  173. 29-09-2003
  174. - property BuildMipsMaps added (default = true)
  175. if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
  176. - property FreeDataAfterGenTexture added (default = true)
  177. if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
  178. - parameter DisableOtherTextureUnits of Bind removed
  179. - parameter FreeDataAfterGeneration of GenTextures removed
  180. 12-09-2003
  181. - TglBitmap dosn't delete data if class was destroyed (fixed)
  182. 09-09-2003
  183. - Bind now enables TextureUnits (by params)
  184. - GenTextures can leave data (by param)
  185. - LoadTextures now optimal
  186. 03-09-2003
  187. - Performance optimization in AddFunc
  188. - procedure Bind moved to subclasses
  189. - Added new Class TglBitmap1D to support real OpenGL 1D Textures
  190. 19-08-2003
  191. - Texturefilter and texturewrap now also as defaults
  192. Minfilter = GL_LINEAR_MIPMAP_LINEAR
  193. Magfilter = GL_LINEAR
  194. Wrap(str) = GL_CLAMP_TO_EDGE
  195. - Added new format tfCompressed to create a compressed texture.
  196. - propertys IsCompressed, TextureSize and IsResident added
  197. IsCompressed and TextureSize only contains data from level 0
  198. 18-08-2003
  199. - Added function AddFunc to add PerPixelEffects to Image
  200. - LoadFromFunc now based on AddFunc
  201. - Invert now based on AddFunc
  202. - SwapColors now based on AddFunc
  203. 16-08-2003
  204. - Added function FlipHorz
  205. 15-08-2003
  206. - Added function LaodFromFunc to create images with function
  207. - Added function FlipVert
  208. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
  209. 29-07-2003
  210. - Added Alphafunctions to calculate alpha per function
  211. - Added Alpha from ColorKey using alphafunctions
  212. 28-07-2003
  213. - First full functionally Version of glBitmap
  214. - Support for 24Bit and 32Bit TGA Pictures added
  215. 25-07-2003
  216. - begin of programming
  217. ***********************************************************}
  218. unit glBitmap;
  219. // Please uncomment the defines below to configure the glBitmap to your preferences.
  220. // If you have configured the unit you can uncomment the warning above.
  221. {$MESSAGE error 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  223. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  225. // activate to enable build-in OpenGL support with statically linked methods
  226. // use dglOpenGL.pas if not enabled
  227. {.$DEFINE GLB_NATIVE_OGL_STATIC}
  228. // activate to enable build-in OpenGL support with dynamically linked methods
  229. // use dglOpenGL.pas if not enabled
  230. {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
  231. // activate to enable the support for SDL_surfaces
  232. {.$DEFINE GLB_SDL}
  233. // activate to enable the support for Delphi (including support for Delphi's (not Lazarus') TBitmap)
  234. {.$DEFINE GLB_DELPHI}
  235. // activate to enable the support for TLazIntfImage from Lazarus
  236. {.$DEFINE GLB_LAZARUS}
  237. // activate to enable the support of SDL_image to load files. (READ ONLY)
  238. // If you enable SDL_image all other libraries will be ignored!
  239. {.$DEFINE GLB_SDL_IMAGE}
  240. // activate to enable Lazarus TPortableNetworkGraphic support
  241. // if you enable this pngImage and libPNG will be ignored
  242. {.$DEFINE GLB_LAZ_PNG}
  243. // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
  244. // if you enable pngimage the libPNG will be ignored
  245. {.$DEFINE GLB_PNGIMAGE}
  246. // activate to use the libPNG -> http://www.libpng.org/
  247. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
  248. {.$DEFINE GLB_LIB_PNG}
  249. // activate to enable Lazarus TJPEGImage support
  250. // if you enable this delphi jpegs and libJPEG will be ignored
  251. {.$DEFINE GLB_LAZ_JPEG}
  252. // if you enable delphi jpegs the libJPEG will be ignored
  253. {.$DEFINE GLB_DELPHI_JPEG}
  254. // activate to use the libJPEG -> http://www.ijg.org/
  255. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
  256. {.$DEFINE GLB_LIB_JPEG}
  257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  258. // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  259. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  260. // Delphi Versions
  261. {$IFDEF fpc}
  262. {$MODE Delphi}
  263. {$IFDEF CPUI386}
  264. {$DEFINE CPU386}
  265. {$ASMMODE INTEL}
  266. {$ENDIF}
  267. {$IFNDEF WINDOWS}
  268. {$linklib c}
  269. {$ENDIF}
  270. {$ENDIF}
  271. // Operation System
  272. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  273. {$DEFINE GLB_WIN}
  274. {$ELSEIF DEFINED(LINUX)}
  275. {$DEFINE GLB_LINUX}
  276. {$IFEND}
  277. // native OpenGL Support
  278. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  279. {$DEFINE GLB_NATIVE_OGL}
  280. {$IFEND}
  281. // checking define combinations
  282. //SDL Image
  283. {$IFDEF GLB_SDL_IMAGE}
  284. {$IFNDEF GLB_SDL}
  285. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  286. {$DEFINE GLB_SDL}
  287. {$ENDIF}
  288. {$IFDEF GLB_LAZ_PNG}
  289. {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  290. {$undef GLB_LAZ_PNG}
  291. {$ENDIF}
  292. {$IFDEF GLB_PNGIMAGE}
  293. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  294. {$undef GLB_PNGIMAGE}
  295. {$ENDIF}
  296. {$IFDEF GLB_LAZ_JPEG}
  297. {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  298. {$undef GLB_LAZ_JPEG}
  299. {$ENDIF}
  300. {$IFDEF GLB_DELPHI_JPEG}
  301. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  302. {$undef GLB_DELPHI_JPEG}
  303. {$ENDIF}
  304. {$IFDEF GLB_LIB_PNG}
  305. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  306. {$undef GLB_LIB_PNG}
  307. {$ENDIF}
  308. {$IFDEF GLB_LIB_JPEG}
  309. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  310. {$undef GLB_LIB_JPEG}
  311. {$ENDIF}
  312. {$DEFINE GLB_SUPPORT_PNG_READ}
  313. {$DEFINE GLB_SUPPORT_JPEG_READ}
  314. {$ENDIF}
  315. // Lazarus TPortableNetworkGraphic
  316. {$IFDEF GLB_LAZ_PNG}
  317. {$IFNDEF GLB_LAZARUS}
  318. {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
  319. {$DEFINE GLB_LAZARUS}
  320. {$ENDIF}
  321. {$IFDEF GLB_PNGIMAGE}
  322. {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  323. {$undef GLB_PNGIMAGE}
  324. {$ENDIF}
  325. {$IFDEF GLB_LIB_PNG}
  326. {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  327. {$undef GLB_LIB_PNG}
  328. {$ENDIF}
  329. {$DEFINE GLB_SUPPORT_PNG_READ}
  330. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  331. {$ENDIF}
  332. // PNG Image
  333. {$IFDEF GLB_PNGIMAGE}
  334. {$IFDEF GLB_LIB_PNG}
  335. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  336. {$undef GLB_LIB_PNG}
  337. {$ENDIF}
  338. {$DEFINE GLB_SUPPORT_PNG_READ}
  339. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  340. {$ENDIF}
  341. // libPNG
  342. {$IFDEF GLB_LIB_PNG}
  343. {$DEFINE GLB_SUPPORT_PNG_READ}
  344. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  345. {$ENDIF}
  346. // Lazarus TJPEGImage
  347. {$IFDEF GLB_LAZ_JPEG}
  348. {$IFNDEF GLB_LAZARUS}
  349. {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
  350. {$DEFINE GLB_LAZARUS}
  351. {$ENDIF}
  352. {$IFDEF GLB_DELPHI_JPEG}
  353. {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
  354. {$undef GLB_DELPHI_JPEG}
  355. {$ENDIF}
  356. {$IFDEF GLB_LIB_JPEG}
  357. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
  358. {$undef GLB_LIB_JPEG}
  359. {$ENDIF}
  360. {$DEFINE GLB_SUPPORT_JPEG_READ}
  361. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  362. {$ENDIF}
  363. // JPEG Image
  364. {$IFDEF GLB_DELPHI_JPEG}
  365. {$IFDEF GLB_LIB_JPEG}
  366. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  367. {$undef GLB_LIB_JPEG}
  368. {$ENDIF}
  369. {$DEFINE GLB_SUPPORT_JPEG_READ}
  370. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  371. {$ENDIF}
  372. // libJPEG
  373. {$IFDEF GLB_LIB_JPEG}
  374. {$DEFINE GLB_SUPPORT_JPEG_READ}
  375. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  376. {$ENDIF}
  377. // native OpenGL
  378. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  379. {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
  380. {$IFEND}
  381. // general options
  382. {$EXTENDEDSYNTAX ON}
  383. {$LONGSTRINGS ON}
  384. {$ALIGN ON}
  385. {$IFNDEF FPC}
  386. {$OPTIMIZATION ON}
  387. {$ENDIF}
  388. interface
  389. uses
  390. {$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
  391. {$IF DEFINED(GLB_WIN) AND
  392. (DEFINED(GLB_NATIVE_OGL) OR
  393. DEFINED(GLB_DELPHI))} windows, {$IFEND}
  394. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  395. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  396. {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$ENDIF}
  397. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  398. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  399. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  400. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  401. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  402. Classes, SysUtils;
  403. {$IFDEF GLB_NATIVE_OGL}
  404. const
  405. GL_TRUE = 1;
  406. GL_FALSE = 0;
  407. GL_ZERO = 0;
  408. GL_ONE = 1;
  409. GL_VERSION = $1F02;
  410. GL_EXTENSIONS = $1F03;
  411. GL_TEXTURE_1D = $0DE0;
  412. GL_TEXTURE_2D = $0DE1;
  413. GL_TEXTURE_RECTANGLE = $84F5;
  414. GL_NORMAL_MAP = $8511;
  415. GL_TEXTURE_CUBE_MAP = $8513;
  416. GL_REFLECTION_MAP = $8512;
  417. GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
  418. GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
  419. GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
  420. GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
  421. GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
  422. GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
  423. GL_TEXTURE_WIDTH = $1000;
  424. GL_TEXTURE_HEIGHT = $1001;
  425. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  426. GL_TEXTURE_SWIZZLE_RGBA = $8E46;
  427. GL_S = $2000;
  428. GL_T = $2001;
  429. GL_R = $2002;
  430. GL_Q = $2003;
  431. GL_TEXTURE_GEN_S = $0C60;
  432. GL_TEXTURE_GEN_T = $0C61;
  433. GL_TEXTURE_GEN_R = $0C62;
  434. GL_TEXTURE_GEN_Q = $0C63;
  435. GL_RED = $1903;
  436. GL_GREEN = $1904;
  437. GL_BLUE = $1905;
  438. GL_ALPHA = $1906;
  439. GL_ALPHA4 = $803B;
  440. GL_ALPHA8 = $803C;
  441. GL_ALPHA12 = $803D;
  442. GL_ALPHA16 = $803E;
  443. GL_LUMINANCE = $1909;
  444. GL_LUMINANCE4 = $803F;
  445. GL_LUMINANCE8 = $8040;
  446. GL_LUMINANCE12 = $8041;
  447. GL_LUMINANCE16 = $8042;
  448. GL_LUMINANCE_ALPHA = $190A;
  449. GL_LUMINANCE4_ALPHA4 = $8043;
  450. GL_LUMINANCE6_ALPHA2 = $8044;
  451. GL_LUMINANCE8_ALPHA8 = $8045;
  452. GL_LUMINANCE12_ALPHA4 = $8046;
  453. GL_LUMINANCE12_ALPHA12 = $8047;
  454. GL_LUMINANCE16_ALPHA16 = $8048;
  455. GL_RGB = $1907;
  456. GL_BGR = $80E0;
  457. GL_R3_G3_B2 = $2A10;
  458. GL_RGB4 = $804F;
  459. GL_RGB5 = $8050;
  460. GL_RGB565 = $8D62;
  461. GL_RGB8 = $8051;
  462. GL_RGB10 = $8052;
  463. GL_RGB12 = $8053;
  464. GL_RGB16 = $8054;
  465. GL_RGBA = $1908;
  466. GL_BGRA = $80E1;
  467. GL_RGBA2 = $8055;
  468. GL_RGBA4 = $8056;
  469. GL_RGB5_A1 = $8057;
  470. GL_RGBA8 = $8058;
  471. GL_RGB10_A2 = $8059;
  472. GL_RGBA12 = $805A;
  473. GL_RGBA16 = $805B;
  474. GL_DEPTH_COMPONENT = $1902;
  475. GL_DEPTH_COMPONENT16 = $81A5;
  476. GL_DEPTH_COMPONENT24 = $81A6;
  477. GL_DEPTH_COMPONENT32 = $81A7;
  478. GL_COMPRESSED_RGB = $84ED;
  479. GL_COMPRESSED_RGBA = $84EE;
  480. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  481. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  482. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  483. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  484. GL_UNSIGNED_BYTE = $1401;
  485. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  486. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  487. GL_UNSIGNED_SHORT = $1403;
  488. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  489. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  490. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  491. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  492. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  493. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  494. GL_UNSIGNED_INT = $1405;
  495. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  496. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  497. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  498. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  499. { Texture Filter }
  500. GL_TEXTURE_MAG_FILTER = $2800;
  501. GL_TEXTURE_MIN_FILTER = $2801;
  502. GL_NEAREST = $2600;
  503. GL_NEAREST_MIPMAP_NEAREST = $2700;
  504. GL_NEAREST_MIPMAP_LINEAR = $2702;
  505. GL_LINEAR = $2601;
  506. GL_LINEAR_MIPMAP_NEAREST = $2701;
  507. GL_LINEAR_MIPMAP_LINEAR = $2703;
  508. { Texture Wrap }
  509. GL_TEXTURE_WRAP_S = $2802;
  510. GL_TEXTURE_WRAP_T = $2803;
  511. GL_TEXTURE_WRAP_R = $8072;
  512. GL_CLAMP = $2900;
  513. GL_REPEAT = $2901;
  514. GL_CLAMP_TO_EDGE = $812F;
  515. GL_CLAMP_TO_BORDER = $812D;
  516. GL_MIRRORED_REPEAT = $8370;
  517. { Other }
  518. GL_GENERATE_MIPMAP = $8191;
  519. GL_TEXTURE_BORDER_COLOR = $1004;
  520. GL_MAX_TEXTURE_SIZE = $0D33;
  521. GL_PACK_ALIGNMENT = $0D05;
  522. GL_UNPACK_ALIGNMENT = $0CF5;
  523. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  524. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  525. GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
  526. GL_TEXTURE_GEN_MODE = $2500;
  527. {$IF DEFINED(GLB_WIN)}
  528. libglu = 'glu32.dll';
  529. libopengl = 'opengl32.dll';
  530. {$ELSEIF DEFINED(GLB_LINUX)}
  531. libglu = 'libGLU.so.1';
  532. libopengl = 'libGL.so.1';
  533. {$IFEND}
  534. type
  535. GLboolean = BYTEBOOL;
  536. GLint = Integer;
  537. GLsizei = Integer;
  538. GLuint = Cardinal;
  539. GLfloat = Single;
  540. GLenum = Cardinal;
  541. PGLvoid = Pointer;
  542. PGLboolean = ^GLboolean;
  543. PGLint = ^GLint;
  544. PGLuint = ^GLuint;
  545. PGLfloat = ^GLfloat;
  546. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  547. TglCompressedTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  548. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  549. {$IF DEFINED(GLB_WIN)}
  550. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  551. {$ELSEIF DEFINED(GLB_LINUX)}
  552. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  553. TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
  554. {$IFEND}
  555. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  556. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  557. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  558. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  559. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  560. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  561. TglTexParameteriv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  562. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  563. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  564. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  565. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  566. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  567. TglTexGeni = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  568. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  569. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  570. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  571. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  572. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  573. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  574. TglTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  575. TglTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  576. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  577. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  578. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  579. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  580. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  581. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  582. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  583. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  584. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  585. procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  586. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  587. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  588. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  589. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  590. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  591. procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  592. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  593. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  594. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  595. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  596. procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  597. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  598. procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  599. procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  600. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  601. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  602. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  603. {$IFEND}
  604. var
  605. GL_VERSION_1_2,
  606. GL_VERSION_1_3,
  607. GL_VERSION_1_4,
  608. GL_VERSION_2_0,
  609. GL_VERSION_3_3,
  610. GL_SGIS_generate_mipmap,
  611. GL_ARB_texture_border_clamp,
  612. GL_ARB_texture_mirrored_repeat,
  613. GL_ARB_texture_rectangle,
  614. GL_ARB_texture_non_power_of_two,
  615. GL_ARB_texture_swizzle,
  616. GL_ARB_texture_cube_map,
  617. GL_IBM_texture_mirrored_repeat,
  618. GL_NV_texture_rectangle,
  619. GL_EXT_texture_edge_clamp,
  620. GL_EXT_texture_rectangle,
  621. GL_EXT_texture_swizzle,
  622. GL_EXT_texture_cube_map,
  623. GL_EXT_texture_filter_anisotropic: Boolean;
  624. glCompressedTexImage1D: TglCompressedTexImage1D;
  625. glCompressedTexImage2D: TglCompressedTexImage2D;
  626. glGetCompressedTexImage: TglGetCompressedTexImage;
  627. {$IF DEFINED(GLB_WIN)}
  628. wglGetProcAddress: TwglGetProcAddress;
  629. {$ELSEIF DEFINED(GLB_LINUX)}
  630. glXGetProcAddress: TglXGetProcAddress;
  631. glXGetProcAddressARB: TglXGetProcAddress;
  632. {$IFEND}
  633. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  634. glEnable: TglEnable;
  635. glDisable: TglDisable;
  636. glGetString: TglGetString;
  637. glGetIntegerv: TglGetIntegerv;
  638. glTexParameteri: TglTexParameteri;
  639. glTexParameteriv: TglTexParameteriv;
  640. glTexParameterfv: TglTexParameterfv;
  641. glGetTexParameteriv: TglGetTexParameteriv;
  642. glGetTexParameterfv: TglGetTexParameterfv;
  643. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  644. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  645. glTexGeni: TglTexGeni;
  646. glGenTextures: TglGenTextures;
  647. glBindTexture: TglBindTexture;
  648. glDeleteTextures: TglDeleteTextures;
  649. glAreTexturesResident: TglAreTexturesResident;
  650. glReadPixels: TglReadPixels;
  651. glPixelStorei: TglPixelStorei;
  652. glTexImage1D: TglTexImage1D;
  653. glTexImage2D: TglTexImage2D;
  654. glGetTexImage: TglGetTexImage;
  655. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  656. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  657. {$ENDIF}
  658. {$ENDIF}
  659. type
  660. ////////////////////////////////////////////////////////////////////////////////////////////////////
  661. 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. const
  1035. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1036. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1037. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1038. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1039. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1040. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1041. procedure glBitmapSetDefaultWrap(
  1042. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1043. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1044. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1045. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1046. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1047. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1048. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1049. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1050. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1051. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1052. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1053. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1054. var
  1055. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1056. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1057. glBitmapDefaultFormat: TglBitmapFormat;
  1058. glBitmapDefaultMipmap: TglBitmapMipMap;
  1059. glBitmapDefaultFilterMin: Cardinal;
  1060. glBitmapDefaultFilterMag: Cardinal;
  1061. glBitmapDefaultWrapS: Cardinal;
  1062. glBitmapDefaultWrapT: Cardinal;
  1063. glBitmapDefaultWrapR: Cardinal;
  1064. glDefaultSwizzle: array[0..3] of GLenum;
  1065. {$IFDEF GLB_DELPHI}
  1066. function CreateGrayPalette: HPALETTE;
  1067. {$ENDIF}
  1068. implementation
  1069. uses
  1070. Math, syncobjs, typinfo
  1071. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1072. type
  1073. {$IFNDEF fpc}
  1074. QWord = System.UInt64;
  1075. PQWord = ^QWord;
  1076. PtrInt = Longint;
  1077. PtrUInt = DWord;
  1078. {$ENDIF}
  1079. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1080. TShiftRec = packed record
  1081. case Integer of
  1082. 0: (r, g, b, a: Byte);
  1083. 1: (arr: array[0..3] of Byte);
  1084. end;
  1085. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1086. private
  1087. function GetRedMask: QWord;
  1088. function GetGreenMask: QWord;
  1089. function GetBlueMask: QWord;
  1090. function GetAlphaMask: QWord;
  1091. protected
  1092. fFormat: TglBitmapFormat;
  1093. fWithAlpha: TglBitmapFormat;
  1094. fWithoutAlpha: TglBitmapFormat;
  1095. fOpenGLFormat: TglBitmapFormat;
  1096. fRGBInverted: TglBitmapFormat;
  1097. fUncompressed: TglBitmapFormat;
  1098. fPixelSize: Single;
  1099. fIsCompressed: Boolean;
  1100. fRange: TglBitmapColorRec;
  1101. fShift: TShiftRec;
  1102. fglFormat: GLenum;
  1103. fglInternalFormat: GLenum;
  1104. fglDataFormat: GLenum;
  1105. function GetIsCompressed: Boolean; override;
  1106. function GetHasRed: Boolean; override;
  1107. function GetHasGreen: Boolean; override;
  1108. function GetHasBlue: Boolean; override;
  1109. function GetHasAlpha: Boolean; override;
  1110. function GetRGBInverted: TglBitmapFormat; override;
  1111. function GetWithAlpha: TglBitmapFormat; override;
  1112. function GetWithoutAlpha: TglBitmapFormat; override;
  1113. function GetOpenGLFormat: TglBitmapFormat; override;
  1114. function GetUncompressed: TglBitmapFormat; override;
  1115. function GetglFormat: GLenum; override;
  1116. function GetglInternalFormat: GLenum; override;
  1117. function GetglDataFormat: GLenum; override;
  1118. function GetComponents: Integer; virtual;
  1119. public
  1120. property Format: TglBitmapFormat read fFormat;
  1121. property Components: Integer read GetComponents;
  1122. property PixelSize: Single read fPixelSize;
  1123. property Range: TglBitmapColorRec read fRange;
  1124. property Shift: TShiftRec read fShift;
  1125. property RedMask: QWord read GetRedMask;
  1126. property GreenMask: QWord read GetGreenMask;
  1127. property BlueMask: QWord read GetBlueMask;
  1128. property AlphaMask: QWord read GetAlphaMask;
  1129. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1130. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1131. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1132. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1133. function CreateMappingData: Pointer; virtual;
  1134. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1135. function IsEmpty: Boolean; virtual;
  1136. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  1137. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1138. constructor Create; virtual;
  1139. public
  1140. class procedure Init;
  1141. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1142. class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1143. class procedure Clear;
  1144. class procedure Finalize;
  1145. end;
  1146. TFormatDescriptorClass = class of TFormatDescriptor;
  1147. TfdEmpty = class(TFormatDescriptor);
  1148. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1149. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1150. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1151. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1152. end;
  1153. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1154. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1155. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1156. end;
  1157. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1158. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1159. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1160. end;
  1161. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1162. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1163. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1164. end;
  1165. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1166. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1167. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1168. end;
  1169. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1170. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1171. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1172. end;
  1173. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1174. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  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. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  1179. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1180. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1181. end;
  1182. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1183. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1184. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1185. end;
  1186. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1187. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1188. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1189. end;
  1190. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1191. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1192. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1193. end;
  1194. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1195. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1196. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1197. end;
  1198. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1199. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1200. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1201. end;
  1202. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1203. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1204. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1205. end;
  1206. TfdARGB_US4 = class(TfdRGB_US3) //4* unsigned short
  1207. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1208. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1209. end;
  1210. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1211. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1212. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1213. end;
  1214. TfdABGR_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1215. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1216. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1217. end;
  1218. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1219. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  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. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1224. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1225. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1226. end;
  1227. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1228. TfdAlpha4 = class(TfdAlpha_UB1)
  1229. constructor Create; override;
  1230. end;
  1231. TfdAlpha8 = class(TfdAlpha_UB1)
  1232. constructor Create; override;
  1233. end;
  1234. TfdAlpha16 = class(TfdAlpha_US1)
  1235. constructor Create; override;
  1236. end;
  1237. TfdLuminance4 = class(TfdLuminance_UB1)
  1238. constructor Create; override;
  1239. end;
  1240. TfdLuminance8 = class(TfdLuminance_UB1)
  1241. constructor Create; override;
  1242. end;
  1243. TfdLuminance16 = class(TfdLuminance_US1)
  1244. constructor Create; override;
  1245. end;
  1246. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1247. constructor Create; override;
  1248. end;
  1249. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1250. constructor Create; override;
  1251. end;
  1252. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1253. constructor Create; override;
  1254. end;
  1255. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1256. constructor Create; override;
  1257. end;
  1258. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1259. constructor Create; override;
  1260. end;
  1261. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1262. TfdR3G3B2 = class(TfdUniversal_UB1)
  1263. constructor Create; override;
  1264. end;
  1265. TfdRGBX4 = class(TfdUniversal_US1)
  1266. constructor Create; override;
  1267. end;
  1268. TfdXRGB4 = class(TfdUniversal_US1)
  1269. constructor Create; override;
  1270. end;
  1271. TfdR5G6B5 = class(TfdUniversal_US1)
  1272. constructor Create; override;
  1273. end;
  1274. TfdRGB5X1 = class(TfdUniversal_US1)
  1275. constructor Create; override;
  1276. end;
  1277. TfdX1RGB5 = class(TfdUniversal_US1)
  1278. constructor Create; override;
  1279. end;
  1280. TfdRGB8 = class(TfdRGB_UB3)
  1281. constructor Create; override;
  1282. end;
  1283. TfdRGBX8 = class(TfdUniversal_UI1)
  1284. constructor Create; override;
  1285. end;
  1286. TfdXRGB8 = class(TfdUniversal_UI1)
  1287. constructor Create; override;
  1288. end;
  1289. TfdRGB10X2 = class(TfdUniversal_UI1)
  1290. constructor Create; override;
  1291. end;
  1292. TfdX2RGB10 = class(TfdUniversal_UI1)
  1293. constructor Create; override;
  1294. end;
  1295. TfdRGB16 = class(TfdRGB_US3)
  1296. constructor Create; override;
  1297. end;
  1298. TfdRGBA4 = class(TfdUniversal_US1)
  1299. constructor Create; override;
  1300. end;
  1301. TfdARGB4 = class(TfdUniversal_US1)
  1302. constructor Create; override;
  1303. end;
  1304. TfdRGB5A1 = class(TfdUniversal_US1)
  1305. constructor Create; override;
  1306. end;
  1307. TfdA1RGB5 = class(TfdUniversal_US1)
  1308. constructor Create; override;
  1309. end;
  1310. TfdRGBA8 = class(TfdUniversal_UI1)
  1311. constructor Create; override;
  1312. end;
  1313. TfdARGB8 = class(TfdUniversal_UI1)
  1314. constructor Create; override;
  1315. end;
  1316. TfdRGB10A2 = class(TfdUniversal_UI1)
  1317. constructor Create; override;
  1318. end;
  1319. TfdA2RGB10 = class(TfdUniversal_UI1)
  1320. constructor Create; override;
  1321. end;
  1322. TfdRGBA16 = class(TfdUniversal_UI1)
  1323. constructor Create; override;
  1324. end;
  1325. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1326. TfdBGRX4 = class(TfdUniversal_US1)
  1327. constructor Create; override;
  1328. end;
  1329. TfdXBGR4 = class(TfdUniversal_US1)
  1330. constructor Create; override;
  1331. end;
  1332. TfdB5G6R5 = class(TfdUniversal_US1)
  1333. constructor Create; override;
  1334. end;
  1335. TfdBGR5X1 = class(TfdUniversal_US1)
  1336. constructor Create; override;
  1337. end;
  1338. TfdX1BGR5 = class(TfdUniversal_US1)
  1339. constructor Create; override;
  1340. end;
  1341. TfdBGR8 = class(TfdBGR_UB3)
  1342. constructor Create; override;
  1343. end;
  1344. TfdBGRX8 = class(TfdUniversal_UI1)
  1345. constructor Create; override;
  1346. end;
  1347. TfdXBGR8 = class(TfdUniversal_UI1)
  1348. constructor Create; override;
  1349. end;
  1350. TfdBGR10X2 = class(TfdUniversal_UI1)
  1351. constructor Create; override;
  1352. end;
  1353. TfdX2BGR10 = class(TfdUniversal_UI1)
  1354. constructor Create; override;
  1355. end;
  1356. TfdBGR16 = class(TfdBGR_US3)
  1357. constructor Create; override;
  1358. end;
  1359. TfdBGRA4 = class(TfdUniversal_US1)
  1360. constructor Create; override;
  1361. end;
  1362. TfdABGR4 = class(TfdUniversal_US1)
  1363. constructor Create; override;
  1364. end;
  1365. TfdBGR5A1 = class(TfdUniversal_US1)
  1366. constructor Create; override;
  1367. end;
  1368. TfdA1BGR5 = class(TfdUniversal_US1)
  1369. constructor Create; override;
  1370. end;
  1371. TfdBGRA8 = class(TfdUniversal_UI1)
  1372. constructor Create; override;
  1373. end;
  1374. TfdABGR8 = class(TfdUniversal_UI1)
  1375. constructor Create; override;
  1376. end;
  1377. TfdBGR10A2 = class(TfdUniversal_UI1)
  1378. constructor Create; override;
  1379. end;
  1380. TfdA2BGR10 = class(TfdUniversal_UI1)
  1381. constructor Create; override;
  1382. end;
  1383. TfdBGRA16 = class(TfdBGRA_US4)
  1384. constructor Create; override;
  1385. end;
  1386. TfdDepth16 = class(TfdDepth_US1)
  1387. constructor Create; override;
  1388. end;
  1389. TfdDepth24 = class(TfdDepth_UI1)
  1390. constructor Create; override;
  1391. end;
  1392. TfdDepth32 = class(TfdDepth_UI1)
  1393. constructor Create; override;
  1394. end;
  1395. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1396. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1397. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1398. constructor Create; override;
  1399. end;
  1400. TfdS3tcDtx3RGBA = 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. TfdS3tcDtx5RGBA = 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. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1411. TbmpBitfieldFormat = class(TFormatDescriptor)
  1412. private
  1413. procedure SetRedMask (const aValue: QWord);
  1414. procedure SetGreenMask(const aValue: QWord);
  1415. procedure SetBlueMask (const aValue: QWord);
  1416. procedure SetAlphaMask(const aValue: QWord);
  1417. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1418. public
  1419. property RedMask: QWord read GetRedMask write SetRedMask;
  1420. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1421. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1422. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1423. property PixelSize: Single read fPixelSize write fPixelSize;
  1424. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1425. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1426. end;
  1427. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1428. TbmpColorTableEnty = packed record
  1429. b, g, r, a: Byte;
  1430. end;
  1431. TbmpColorTable = array of TbmpColorTableEnty;
  1432. TbmpColorTableFormat = class(TFormatDescriptor)
  1433. private
  1434. fColorTable: TbmpColorTable;
  1435. public
  1436. property PixelSize: Single read fPixelSize write fPixelSize;
  1437. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1438. property Range: TglBitmapColorRec read fRange write fRange;
  1439. property Shift: TShiftRec read fShift write fShift;
  1440. property Format: TglBitmapFormat read fFormat write fFormat;
  1441. procedure CreateColorTable;
  1442. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1443. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1444. destructor Destroy; override;
  1445. end;
  1446. const
  1447. LUMINANCE_WEIGHT_R = 0.30;
  1448. LUMINANCE_WEIGHT_G = 0.59;
  1449. LUMINANCE_WEIGHT_B = 0.11;
  1450. ALPHA_WEIGHT_R = 0.30;
  1451. ALPHA_WEIGHT_G = 0.59;
  1452. ALPHA_WEIGHT_B = 0.11;
  1453. DEPTH_WEIGHT_R = 0.333333333;
  1454. DEPTH_WEIGHT_G = 0.333333333;
  1455. DEPTH_WEIGHT_B = 0.333333333;
  1456. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1457. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1458. TfdEmpty,
  1459. TfdAlpha4,
  1460. TfdAlpha8,
  1461. TfdAlpha16,
  1462. TfdLuminance4,
  1463. TfdLuminance8,
  1464. TfdLuminance16,
  1465. TfdLuminance4Alpha4,
  1466. TfdLuminance6Alpha2,
  1467. TfdLuminance8Alpha8,
  1468. TfdLuminance12Alpha4,
  1469. TfdLuminance16Alpha16,
  1470. TfdR3G3B2,
  1471. TfdRGBX4,
  1472. TfdXRGB4,
  1473. TfdR5G6B5,
  1474. TfdRGB5X1,
  1475. TfdX1RGB5,
  1476. TfdRGB8,
  1477. TfdRGBX8,
  1478. TfdXRGB8,
  1479. TfdRGB10X2,
  1480. TfdX2RGB10,
  1481. TfdRGB16,
  1482. TfdRGBA4,
  1483. TfdARGB4,
  1484. TfdRGB5A1,
  1485. TfdA1RGB5,
  1486. TfdRGBA8,
  1487. TfdARGB8,
  1488. TfdRGB10A2,
  1489. TfdA2RGB10,
  1490. TfdRGBA16,
  1491. TfdBGRX4,
  1492. TfdXBGR4,
  1493. TfdB5G6R5,
  1494. TfdBGR5X1,
  1495. TfdX1BGR5,
  1496. TfdBGR8,
  1497. TfdBGRX8,
  1498. TfdXBGR8,
  1499. TfdBGR10X2,
  1500. TfdX2BGR10,
  1501. TfdBGR16,
  1502. TfdBGRA4,
  1503. TfdABGR4,
  1504. TfdBGR5A1,
  1505. TfdA1BGR5,
  1506. TfdBGRA8,
  1507. TfdABGR8,
  1508. TfdBGR10A2,
  1509. TfdA2BGR10,
  1510. TfdBGRA16,
  1511. TfdDepth16,
  1512. TfdDepth24,
  1513. TfdDepth32,
  1514. TfdS3tcDtx1RGBA,
  1515. TfdS3tcDtx3RGBA,
  1516. TfdS3tcDtx5RGBA
  1517. );
  1518. var
  1519. FormatDescriptorCS: TCriticalSection;
  1520. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1521. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1522. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1523. begin
  1524. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1525. end;
  1526. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1527. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1528. begin
  1529. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1530. end;
  1531. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1532. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1533. begin
  1534. result.Fields := [];
  1535. if X >= 0 then
  1536. result.Fields := result.Fields + [ffX];
  1537. if Y >= 0 then
  1538. result.Fields := result.Fields + [ffY];
  1539. result.X := Max(0, X);
  1540. result.Y := Max(0, Y);
  1541. end;
  1542. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1543. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1544. begin
  1545. result.r := r;
  1546. result.g := g;
  1547. result.b := b;
  1548. result.a := a;
  1549. end;
  1550. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1551. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1552. var
  1553. i: Integer;
  1554. begin
  1555. result := false;
  1556. for i := 0 to high(r1.arr) do
  1557. if (r1.arr[i] <> r2.arr[i]) then
  1558. exit;
  1559. result := true;
  1560. end;
  1561. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1562. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1563. begin
  1564. result.r := r;
  1565. result.g := g;
  1566. result.b := b;
  1567. result.a := a;
  1568. end;
  1569. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1570. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1571. begin
  1572. result := [];
  1573. if (aFormat in [
  1574. //4 bbp
  1575. tfLuminance4,
  1576. //8bpp
  1577. tfR3G3B2, tfLuminance8,
  1578. //16bpp
  1579. tfRGBX4, tfXRGB4, tfRGB5X1, tfX1RGB5, tfR5G6B5, tfRGB5A1, tfA1RGB5, tfRGBA4, tfARGB4,
  1580. tfBGRX4, tfXBGR4, tfBGR5X1, tfX1BGR5, tfB5G6R5, tfBGR5A1, tfA1BGR5, tfBGRA4, tfABGR4,
  1581. //24bpp
  1582. tfBGR8, tfRGB8,
  1583. //32bpp
  1584. tfRGB10X2, tfX2RGB10, tfRGB10A2, tfA2RGB10, tfRGBA8, tfARGB8,
  1585. tfBGR10X2, tfX2BGR10, tfBGR10A2, tfA2BGR10, tfBGRA8, tfABGR8]) then
  1586. result := result + [ftBMP];
  1587. if (aFormat in [
  1588. //8 bpp
  1589. tfLuminance8, tfAlpha8,
  1590. //16 bpp
  1591. tfLuminance16, tfLuminance8Alpha8,
  1592. tfRGB5X1, tfX1RGB5, tfRGB5A1, tfA1RGB5, tfRGBA4, tfARGB4,
  1593. tfBGR5X1, tfX1BGR5, tfBGR5A1, tfA1BGR5, tfBGRA4, tfABGR4,
  1594. //24 bpp
  1595. tfRGB8, tfBGR8,
  1596. //32 bpp
  1597. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1598. result := result + [ftTGA];
  1599. if (aFormat in [
  1600. //8 bpp
  1601. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1602. tfR3G3B2,
  1603. //16 bpp
  1604. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1605. tfRGBX4, tfXRGB4, tfR5G6B5, tfRGB5X1, tfX1RGB5, tfRGBA4, tfARGB4, tfRGB5A1, tfA1RGB5,
  1606. tfBGRX4, tfXBGR4, tfB5G6R5, tfBGR5X1, tfX1BGR5, tfBGRA4, tfABGR4, tfBGR5A1, tfA1BGR5,
  1607. //24 bpp
  1608. tfRGB8, tfBGR8,
  1609. //32 bbp
  1610. tfLuminance16Alpha16,
  1611. tfRGBA8, tfRGB10A2,
  1612. tfBGRA8, tfBGR10A2,
  1613. //compressed
  1614. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1615. result := result + [ftDDS];
  1616. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1617. if aFormat in [
  1618. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1619. tfRGB8, tfRGBA8,
  1620. tfBGR8, tfBGRA8] then
  1621. result := result + [ftPNG];
  1622. {$ENDIF}
  1623. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1624. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1625. result := result + [ftJPEG];
  1626. {$ENDIF}
  1627. end;
  1628. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1629. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1630. begin
  1631. while (aNumber and 1) = 0 do
  1632. aNumber := aNumber shr 1;
  1633. result := aNumber = 1;
  1634. end;
  1635. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1636. function GetTopMostBit(aBitSet: QWord): Integer;
  1637. begin
  1638. result := 0;
  1639. while aBitSet > 0 do begin
  1640. inc(result);
  1641. aBitSet := aBitSet shr 1;
  1642. end;
  1643. end;
  1644. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1645. function CountSetBits(aBitSet: QWord): Integer;
  1646. begin
  1647. result := 0;
  1648. while aBitSet > 0 do begin
  1649. if (aBitSet and 1) = 1 then
  1650. inc(result);
  1651. aBitSet := aBitSet shr 1;
  1652. end;
  1653. end;
  1654. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1655. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1656. begin
  1657. result := Trunc(
  1658. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1659. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1660. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1661. end;
  1662. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1663. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1664. begin
  1665. result := Trunc(
  1666. DEPTH_WEIGHT_R * aPixel.Data.r +
  1667. DEPTH_WEIGHT_G * aPixel.Data.g +
  1668. DEPTH_WEIGHT_B * aPixel.Data.b);
  1669. end;
  1670. {$IFDEF GLB_NATIVE_OGL}
  1671. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1672. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1673. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1674. var
  1675. GL_LibHandle: Pointer = nil;
  1676. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
  1677. begin
  1678. if not Assigned(aLibHandle) then
  1679. aLibHandle := GL_LibHandle;
  1680. {$IF DEFINED(GLB_WIN)}
  1681. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1682. if Assigned(result) then
  1683. exit;
  1684. if Assigned(wglGetProcAddress) then
  1685. result := wglGetProcAddress(aProcName);
  1686. {$ELSEIF DEFINED(GLB_LINUX)}
  1687. if Assigned(glXGetProcAddress) then begin
  1688. result := glXGetProcAddress(aProcName);
  1689. if Assigned(result) then
  1690. exit;
  1691. end;
  1692. if Assigned(glXGetProcAddressARB) then begin
  1693. result := glXGetProcAddressARB(aProcName);
  1694. if Assigned(result) then
  1695. exit;
  1696. end;
  1697. result := dlsym(aLibHandle, aProcName);
  1698. {$IFEND}
  1699. if not Assigned(result) and aRaiseOnErr then
  1700. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1701. end;
  1702. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1703. var
  1704. GLU_LibHandle: Pointer = nil;
  1705. OpenGLInitialized: Boolean;
  1706. InitOpenGLCS: TCriticalSection;
  1707. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1708. procedure glbInitOpenGL;
  1709. ////////////////////////////////////////////////////////////////////////////////
  1710. function glbLoadLibrary(const aName: PChar): Pointer;
  1711. begin
  1712. {$IF DEFINED(GLB_WIN)}
  1713. result := {%H-}Pointer(LoadLibrary(aName));
  1714. {$ELSEIF DEFINED(GLB_LINUX)}
  1715. result := dlopen(Name, RTLD_LAZY);
  1716. {$ELSE}
  1717. result := nil;
  1718. {$IFEND}
  1719. end;
  1720. ////////////////////////////////////////////////////////////////////////////////
  1721. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1722. begin
  1723. result := false;
  1724. if not Assigned(aLibHandle) then
  1725. exit;
  1726. {$IF DEFINED(GLB_WIN)}
  1727. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1728. {$ELSEIF DEFINED(GLB_LINUX)}
  1729. Result := dlclose(aLibHandle) = 0;
  1730. {$IFEND}
  1731. end;
  1732. begin
  1733. if Assigned(GL_LibHandle) then
  1734. glbFreeLibrary(GL_LibHandle);
  1735. if Assigned(GLU_LibHandle) then
  1736. glbFreeLibrary(GLU_LibHandle);
  1737. GL_LibHandle := glbLoadLibrary(libopengl);
  1738. if not Assigned(GL_LibHandle) then
  1739. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1740. GLU_LibHandle := glbLoadLibrary(libglu);
  1741. if not Assigned(GLU_LibHandle) then
  1742. raise EglBitmap.Create('unable to load library: ' + libglu);
  1743. {$IF DEFINED(GLB_WIN)}
  1744. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1745. {$ELSEIF DEFINED(GLB_LINUX)}
  1746. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1747. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1748. {$IFEND}
  1749. glEnable := glbGetProcAddress('glEnable');
  1750. glDisable := glbGetProcAddress('glDisable');
  1751. glGetString := glbGetProcAddress('glGetString');
  1752. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1753. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1754. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1755. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1756. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1757. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1758. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1759. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1760. glTexGeni := glbGetProcAddress('glTexGeni');
  1761. glGenTextures := glbGetProcAddress('glGenTextures');
  1762. glBindTexture := glbGetProcAddress('glBindTexture');
  1763. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1764. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1765. glReadPixels := glbGetProcAddress('glReadPixels');
  1766. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1767. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1768. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1769. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1770. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1771. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1772. end;
  1773. {$ENDIF}
  1774. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1775. procedure glbReadOpenGLExtensions;
  1776. var
  1777. Buffer: AnsiString;
  1778. MajorVersion, MinorVersion: Integer;
  1779. ///////////////////////////////////////////////////////////////////////////////////////////
  1780. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1781. var
  1782. Separator: Integer;
  1783. begin
  1784. aMinor := 0;
  1785. aMajor := 0;
  1786. Separator := Pos(AnsiString('.'), aBuffer);
  1787. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1788. (aBuffer[Separator - 1] in ['0'..'9']) and
  1789. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1790. Dec(Separator);
  1791. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1792. Dec(Separator);
  1793. Delete(aBuffer, 1, Separator);
  1794. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1795. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1796. Inc(Separator);
  1797. Delete(aBuffer, Separator, 255);
  1798. Separator := Pos(AnsiString('.'), aBuffer);
  1799. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1800. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1801. end;
  1802. end;
  1803. ///////////////////////////////////////////////////////////////////////////////////////////
  1804. function CheckExtension(const Extension: AnsiString): Boolean;
  1805. var
  1806. ExtPos: Integer;
  1807. begin
  1808. ExtPos := Pos(Extension, Buffer);
  1809. result := ExtPos > 0;
  1810. if result then
  1811. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1812. end;
  1813. ///////////////////////////////////////////////////////////////////////////////////////////
  1814. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1815. begin
  1816. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1817. end;
  1818. begin
  1819. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1820. InitOpenGLCS.Enter;
  1821. try
  1822. if not OpenGLInitialized then begin
  1823. glbInitOpenGL;
  1824. OpenGLInitialized := true;
  1825. end;
  1826. finally
  1827. InitOpenGLCS.Leave;
  1828. end;
  1829. {$ENDIF}
  1830. // Version
  1831. Buffer := glGetString(GL_VERSION);
  1832. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1833. GL_VERSION_1_2 := CheckVersion(1, 2);
  1834. GL_VERSION_1_3 := CheckVersion(1, 3);
  1835. GL_VERSION_1_4 := CheckVersion(1, 4);
  1836. GL_VERSION_2_0 := CheckVersion(2, 0);
  1837. GL_VERSION_3_3 := CheckVersion(3, 3);
  1838. // Extensions
  1839. Buffer := glGetString(GL_EXTENSIONS);
  1840. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1841. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1842. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1843. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1844. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1845. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1846. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1847. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1848. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1849. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1850. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1851. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1852. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1853. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1854. if GL_VERSION_1_3 then begin
  1855. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1856. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1857. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1858. end else begin
  1859. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false);
  1860. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false);
  1861. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
  1862. end;
  1863. end;
  1864. {$ENDIF}
  1865. {$IFDEF GLB_SDL_IMAGE}
  1866. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1867. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1868. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1869. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1870. begin
  1871. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1872. end;
  1873. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1874. begin
  1875. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1876. end;
  1877. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1878. begin
  1879. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1880. end;
  1881. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1882. begin
  1883. result := 0;
  1884. end;
  1885. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1886. begin
  1887. result := SDL_AllocRW;
  1888. if result = nil then
  1889. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1890. result^.seek := glBitmapRWseek;
  1891. result^.read := glBitmapRWread;
  1892. result^.write := glBitmapRWwrite;
  1893. result^.close := glBitmapRWclose;
  1894. result^.unknown.data1 := Stream;
  1895. end;
  1896. {$ENDIF}
  1897. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1898. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1899. begin
  1900. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1901. end;
  1902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1903. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1904. begin
  1905. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1906. end;
  1907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1908. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1909. begin
  1910. glBitmapDefaultMipmap := aValue;
  1911. end;
  1912. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1913. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1914. begin
  1915. glBitmapDefaultFormat := aFormat;
  1916. end;
  1917. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1918. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1919. begin
  1920. glBitmapDefaultFilterMin := aMin;
  1921. glBitmapDefaultFilterMag := aMag;
  1922. end;
  1923. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1924. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1925. begin
  1926. glBitmapDefaultWrapS := S;
  1927. glBitmapDefaultWrapT := T;
  1928. glBitmapDefaultWrapR := R;
  1929. end;
  1930. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1931. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1932. begin
  1933. glDefaultSwizzle[0] := r;
  1934. glDefaultSwizzle[1] := g;
  1935. glDefaultSwizzle[2] := b;
  1936. glDefaultSwizzle[3] := a;
  1937. end;
  1938. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1939. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1940. begin
  1941. result := glBitmapDefaultDeleteTextureOnFree;
  1942. end;
  1943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1944. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1945. begin
  1946. result := glBitmapDefaultFreeDataAfterGenTextures;
  1947. end;
  1948. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1949. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1950. begin
  1951. result := glBitmapDefaultMipmap;
  1952. end;
  1953. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1954. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1955. begin
  1956. result := glBitmapDefaultFormat;
  1957. end;
  1958. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1959. procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
  1960. begin
  1961. aMin := glBitmapDefaultFilterMin;
  1962. aMag := glBitmapDefaultFilterMag;
  1963. end;
  1964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1965. procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
  1966. begin
  1967. S := glBitmapDefaultWrapS;
  1968. T := glBitmapDefaultWrapT;
  1969. R := glBitmapDefaultWrapR;
  1970. end;
  1971. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1972. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1973. begin
  1974. r := glDefaultSwizzle[0];
  1975. g := glDefaultSwizzle[1];
  1976. b := glDefaultSwizzle[2];
  1977. a := glDefaultSwizzle[3];
  1978. end;
  1979. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1980. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1981. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1982. function TFormatDescriptor.GetRedMask: QWord;
  1983. begin
  1984. result := fRange.r shl fShift.r;
  1985. end;
  1986. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1987. function TFormatDescriptor.GetGreenMask: QWord;
  1988. begin
  1989. result := fRange.g shl fShift.g;
  1990. end;
  1991. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1992. function TFormatDescriptor.GetBlueMask: QWord;
  1993. begin
  1994. result := fRange.b shl fShift.b;
  1995. end;
  1996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1997. function TFormatDescriptor.GetAlphaMask: QWord;
  1998. begin
  1999. result := fRange.a shl fShift.a;
  2000. end;
  2001. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2002. function TFormatDescriptor.GetIsCompressed: Boolean;
  2003. begin
  2004. result := fIsCompressed;
  2005. end;
  2006. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2007. function TFormatDescriptor.GetHasRed: Boolean;
  2008. begin
  2009. result := (fRange.r > 0);
  2010. end;
  2011. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2012. function TFormatDescriptor.GetHasGreen: Boolean;
  2013. begin
  2014. result := (fRange.g > 0);
  2015. end;
  2016. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2017. function TFormatDescriptor.GetHasBlue: Boolean;
  2018. begin
  2019. result := (fRange.b > 0);
  2020. end;
  2021. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2022. function TFormatDescriptor.GetHasAlpha: Boolean;
  2023. begin
  2024. result := (fRange.a > 0);
  2025. end;
  2026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2027. function TFormatDescriptor.GetRGBInverted: TglBitmapFormat;
  2028. begin
  2029. result := fRGBInverted;
  2030. end;
  2031. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2032. function TFormatDescriptor.GetWithAlpha: TglBitmapFormat;
  2033. begin
  2034. result := fWithAlpha;
  2035. end;
  2036. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2037. function TFormatDescriptor.GetWithoutAlpha: TglBitmapFormat;
  2038. begin
  2039. result := fWithoutAlpha;
  2040. end;
  2041. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2042. function TFormatDescriptor.GetOpenGLFormat: TglBitmapFormat;
  2043. begin
  2044. result := fOpenGLFormat;
  2045. end;
  2046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2047. function TFormatDescriptor.GetUncompressed: TglBitmapFormat;
  2048. begin
  2049. result := fUncompressed;
  2050. end;
  2051. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2052. function TFormatDescriptor.GetglFormat: GLenum;
  2053. begin
  2054. result := fglFormat;
  2055. end;
  2056. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2057. function TFormatDescriptor.GetglInternalFormat: GLenum;
  2058. begin
  2059. result := fglInternalFormat;
  2060. end;
  2061. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2062. function TFormatDescriptor.GetglDataFormat: GLenum;
  2063. begin
  2064. result := fglDataFormat;
  2065. end;
  2066. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2067. function TFormatDescriptor.GetComponents: Integer;
  2068. var
  2069. i: Integer;
  2070. begin
  2071. result := 0;
  2072. for i := 0 to 3 do
  2073. if (fRange.arr[i] > 0) then
  2074. inc(result);
  2075. end;
  2076. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2077. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  2078. var
  2079. w, h: Integer;
  2080. begin
  2081. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  2082. w := Max(1, aSize.X);
  2083. h := Max(1, aSize.Y);
  2084. result := GetSize(w, h);
  2085. end else
  2086. result := 0;
  2087. end;
  2088. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2089. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  2090. begin
  2091. result := 0;
  2092. if (aWidth <= 0) or (aHeight <= 0) then
  2093. exit;
  2094. result := Ceil(aWidth * aHeight * fPixelSize);
  2095. end;
  2096. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2097. function TFormatDescriptor.CreateMappingData: Pointer;
  2098. begin
  2099. result := nil;
  2100. end;
  2101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2102. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2103. begin
  2104. //DUMMY
  2105. end;
  2106. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2107. function TFormatDescriptor.IsEmpty: Boolean;
  2108. begin
  2109. result := (fFormat = tfEmpty);
  2110. end;
  2111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2112. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  2113. begin
  2114. result := false;
  2115. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2116. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2117. if (aRedMask <> RedMask) then
  2118. exit;
  2119. if (aGreenMask <> GreenMask) then
  2120. exit;
  2121. if (aBlueMask <> BlueMask) then
  2122. exit;
  2123. if (aAlphaMask <> AlphaMask) then
  2124. exit;
  2125. result := true;
  2126. end;
  2127. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2128. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2129. begin
  2130. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2131. aPixel.Data := fRange;
  2132. aPixel.Range := fRange;
  2133. aPixel.Format := fFormat;
  2134. end;
  2135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2136. constructor TFormatDescriptor.Create;
  2137. begin
  2138. inherited Create;
  2139. fFormat := tfEmpty;
  2140. fWithAlpha := tfEmpty;
  2141. fWithoutAlpha := tfEmpty;
  2142. fOpenGLFormat := tfEmpty;
  2143. fRGBInverted := tfEmpty;
  2144. fUncompressed := tfEmpty;
  2145. fPixelSize := 0.0;
  2146. fIsCompressed := false;
  2147. fglFormat := 0;
  2148. fglInternalFormat := 0;
  2149. fglDataFormat := 0;
  2150. FillChar(fRange, 0, SizeOf(fRange));
  2151. FillChar(fShift, 0, SizeOf(fShift));
  2152. end;
  2153. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2154. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2155. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2156. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2157. begin
  2158. aData^ := aPixel.Data.a;
  2159. inc(aData);
  2160. end;
  2161. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2162. begin
  2163. aPixel.Data.r := 0;
  2164. aPixel.Data.g := 0;
  2165. aPixel.Data.b := 0;
  2166. aPixel.Data.a := aData^;
  2167. inc(aData);
  2168. end;
  2169. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2170. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2171. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2172. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2173. begin
  2174. aData^ := LuminanceWeight(aPixel);
  2175. inc(aData);
  2176. end;
  2177. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2178. begin
  2179. aPixel.Data.r := aData^;
  2180. aPixel.Data.g := aData^;
  2181. aPixel.Data.b := aData^;
  2182. aPixel.Data.a := 0;
  2183. inc(aData);
  2184. end;
  2185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2186. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2188. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2189. var
  2190. i: Integer;
  2191. begin
  2192. aData^ := 0;
  2193. for i := 0 to 3 do
  2194. if (fRange.arr[i] > 0) then
  2195. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2196. inc(aData);
  2197. end;
  2198. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2199. var
  2200. i: Integer;
  2201. begin
  2202. for i := 0 to 3 do
  2203. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2204. inc(aData);
  2205. end;
  2206. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2207. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2208. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2209. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2210. begin
  2211. inherited Map(aPixel, aData, aMapData);
  2212. aData^ := aPixel.Data.a;
  2213. inc(aData);
  2214. end;
  2215. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2216. begin
  2217. inherited Unmap(aData, aPixel, aMapData);
  2218. aPixel.Data.a := aData^;
  2219. inc(aData);
  2220. end;
  2221. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2222. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2223. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2224. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2225. begin
  2226. aData^ := aPixel.Data.b;
  2227. inc(aData);
  2228. aData^ := aPixel.Data.g;
  2229. inc(aData);
  2230. aData^ := aPixel.Data.r;
  2231. inc(aData);
  2232. end;
  2233. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2234. begin
  2235. aPixel.Data.b := aData^;
  2236. inc(aData);
  2237. aPixel.Data.g := aData^;
  2238. inc(aData);
  2239. aPixel.Data.r := aData^;
  2240. inc(aData);
  2241. aPixel.Data.a := 0;
  2242. end;
  2243. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2244. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2245. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2246. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2247. begin
  2248. aData^ := aPixel.Data.r;
  2249. inc(aData);
  2250. aData^ := aPixel.Data.g;
  2251. inc(aData);
  2252. aData^ := aPixel.Data.b;
  2253. inc(aData);
  2254. end;
  2255. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2256. begin
  2257. aPixel.Data.r := aData^;
  2258. inc(aData);
  2259. aPixel.Data.g := aData^;
  2260. inc(aData);
  2261. aPixel.Data.b := aData^;
  2262. inc(aData);
  2263. aPixel.Data.a := 0;
  2264. end;
  2265. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2266. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2267. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2268. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2269. begin
  2270. PWord(aData)^ := aPixel.Data.a;
  2271. inc(aData, 2);
  2272. end;
  2273. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2274. begin
  2275. aPixel.Data.r := 0;
  2276. aPixel.Data.g := 0;
  2277. aPixel.Data.b := 0;
  2278. aPixel.Data.a := PWord(aData)^;
  2279. inc(aData, 2);
  2280. end;
  2281. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2282. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2283. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2284. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2285. begin
  2286. PWord(aData)^ := LuminanceWeight(aPixel);
  2287. inc(aData, 2);
  2288. end;
  2289. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2290. begin
  2291. aPixel.Data.r := PWord(aData)^;
  2292. aPixel.Data.g := PWord(aData)^;
  2293. aPixel.Data.b := PWord(aData)^;
  2294. aPixel.Data.a := 0;
  2295. inc(aData, 2);
  2296. end;
  2297. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2298. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2299. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2300. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2301. var
  2302. i: Integer;
  2303. begin
  2304. PWord(aData)^ := 0;
  2305. for i := 0 to 3 do
  2306. if (fRange.arr[i] > 0) then
  2307. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2308. inc(aData, 2);
  2309. end;
  2310. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2311. var
  2312. i: Integer;
  2313. begin
  2314. for i := 0 to 3 do
  2315. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2316. inc(aData, 2);
  2317. end;
  2318. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2319. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2320. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2321. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2322. begin
  2323. PWord(aData)^ := DepthWeight(aPixel);
  2324. inc(aData, 2);
  2325. end;
  2326. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2327. begin
  2328. aPixel.Data.r := PWord(aData)^;
  2329. aPixel.Data.g := PWord(aData)^;
  2330. aPixel.Data.b := PWord(aData)^;
  2331. aPixel.Data.a := PWord(aData)^;;
  2332. inc(aData, 2);
  2333. end;
  2334. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2335. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2336. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2337. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2338. begin
  2339. inherited Map(aPixel, aData, aMapData);
  2340. PWord(aData)^ := aPixel.Data.a;
  2341. inc(aData, 2);
  2342. end;
  2343. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2344. begin
  2345. inherited Unmap(aData, aPixel, aMapData);
  2346. aPixel.Data.a := PWord(aData)^;
  2347. inc(aData, 2);
  2348. end;
  2349. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2350. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2351. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2352. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2353. begin
  2354. PWord(aData)^ := aPixel.Data.b;
  2355. inc(aData, 2);
  2356. PWord(aData)^ := aPixel.Data.g;
  2357. inc(aData, 2);
  2358. PWord(aData)^ := aPixel.Data.r;
  2359. inc(aData, 2);
  2360. end;
  2361. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2362. begin
  2363. aPixel.Data.b := PWord(aData)^;
  2364. inc(aData, 2);
  2365. aPixel.Data.g := PWord(aData)^;
  2366. inc(aData, 2);
  2367. aPixel.Data.r := PWord(aData)^;
  2368. inc(aData, 2);
  2369. aPixel.Data.a := 0;
  2370. end;
  2371. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2372. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2373. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2374. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2375. begin
  2376. PWord(aData)^ := aPixel.Data.r;
  2377. inc(aData, 2);
  2378. PWord(aData)^ := aPixel.Data.g;
  2379. inc(aData, 2);
  2380. PWord(aData)^ := aPixel.Data.b;
  2381. inc(aData, 2);
  2382. end;
  2383. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2384. begin
  2385. aPixel.Data.r := PWord(aData)^;
  2386. inc(aData, 2);
  2387. aPixel.Data.g := PWord(aData)^;
  2388. inc(aData, 2);
  2389. aPixel.Data.b := PWord(aData)^;
  2390. inc(aData, 2);
  2391. aPixel.Data.a := 0;
  2392. end;
  2393. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2394. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2395. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2396. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2397. begin
  2398. PWord(aData)^ := aPixel.Data.a;
  2399. inc(aData, 2);
  2400. inherited Map(aPixel, aData, aMapData);
  2401. end;
  2402. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2403. begin
  2404. aPixel.Data.a := PWord(aData)^;
  2405. inc(aData, 2);
  2406. inherited Unmap(aData, aPixel, aMapData);
  2407. end;
  2408. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2409. //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2410. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2411. procedure TfdARGB_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2412. begin
  2413. inherited Map(aPixel, aData, aMapData);
  2414. PWord(aData)^ := aPixel.Data.a;
  2415. inc(aData, 2);
  2416. end;
  2417. procedure TfdARGB_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2418. begin
  2419. inherited Unmap(aData, aPixel, aMapData);
  2420. aPixel.Data.a := PWord(aData)^;
  2421. inc(aData, 2);
  2422. end;
  2423. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2424. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2426. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2427. begin
  2428. PWord(aData)^ := aPixel.Data.a;
  2429. inc(aData, 2);
  2430. inherited Map(aPixel, aData, aMapData);
  2431. end;
  2432. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2433. begin
  2434. aPixel.Data.a := PWord(aData)^;
  2435. inc(aData, 2);
  2436. inherited Unmap(aData, aPixel, aMapData);
  2437. end;
  2438. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2439. //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2440. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2441. procedure TfdABGR_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2442. begin
  2443. inherited Map(aPixel, aData, aMapData);
  2444. PWord(aData)^ := aPixel.Data.a;
  2445. inc(aData, 2);
  2446. end;
  2447. procedure TfdABGR_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2448. begin
  2449. inherited Unmap(aData, aPixel, aMapData);
  2450. aPixel.Data.a := PWord(aData)^;
  2451. inc(aData, 2);
  2452. end;
  2453. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2454. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2455. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2456. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2457. var
  2458. i: Integer;
  2459. begin
  2460. PCardinal(aData)^ := 0;
  2461. for i := 0 to 3 do
  2462. if (fRange.arr[i] > 0) then
  2463. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2464. inc(aData, 4);
  2465. end;
  2466. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2467. var
  2468. i: Integer;
  2469. begin
  2470. for i := 0 to 3 do
  2471. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2472. inc(aData, 2);
  2473. end;
  2474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2475. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2476. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2477. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2478. begin
  2479. PCardinal(aData)^ := DepthWeight(aPixel);
  2480. inc(aData, 4);
  2481. end;
  2482. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2483. begin
  2484. aPixel.Data.r := PCardinal(aData)^;
  2485. aPixel.Data.g := PCardinal(aData)^;
  2486. aPixel.Data.b := PCardinal(aData)^;
  2487. aPixel.Data.a := 0;
  2488. inc(aData, 4);
  2489. end;
  2490. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2491. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2492. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2493. constructor TfdAlpha4.Create;
  2494. begin
  2495. inherited Create;
  2496. fPixelSize := 1.0;
  2497. fFormat := tfAlpha4;
  2498. fWithAlpha := tfAlpha4;
  2499. fOpenGLFormat := tfAlpha4;
  2500. fRange.a := $FF;
  2501. fglFormat := GL_ALPHA;
  2502. fglInternalFormat := GL_ALPHA4;
  2503. fglDataFormat := GL_UNSIGNED_BYTE;
  2504. end;
  2505. constructor TfdAlpha8.Create;
  2506. begin
  2507. inherited Create;
  2508. fPixelSize := 1.0;
  2509. fFormat := tfAlpha8;
  2510. fWithAlpha := tfAlpha8;
  2511. fOpenGLFormat := tfAlpha8;
  2512. fRange.a := $FF;
  2513. fglFormat := GL_ALPHA;
  2514. fglInternalFormat := GL_ALPHA8;
  2515. fglDataFormat := GL_UNSIGNED_BYTE;
  2516. end;
  2517. constructor TfdAlpha16.Create;
  2518. begin
  2519. inherited Create;
  2520. fPixelSize := 2.0;
  2521. fFormat := tfAlpha16;
  2522. fWithAlpha := tfAlpha16;
  2523. fOpenGLFormat := tfAlpha16;
  2524. fRange.a := $FFFF;
  2525. fglFormat := GL_ALPHA;
  2526. fglInternalFormat := GL_ALPHA16;
  2527. fglDataFormat := GL_UNSIGNED_SHORT;
  2528. end;
  2529. constructor TfdLuminance4.Create;
  2530. begin
  2531. inherited Create;
  2532. fPixelSize := 1.0;
  2533. fFormat := tfLuminance4;
  2534. fWithAlpha := tfLuminance4Alpha4;
  2535. fWithoutAlpha := tfLuminance4;
  2536. fOpenGLFormat := tfLuminance4;
  2537. fRange.r := $FF;
  2538. fRange.g := $FF;
  2539. fRange.b := $FF;
  2540. fglFormat := GL_LUMINANCE;
  2541. fglInternalFormat := GL_LUMINANCE4;
  2542. fglDataFormat := GL_UNSIGNED_BYTE;
  2543. end;
  2544. constructor TfdLuminance8.Create;
  2545. begin
  2546. inherited Create;
  2547. fPixelSize := 1.0;
  2548. fFormat := tfLuminance8;
  2549. fWithAlpha := tfLuminance8Alpha8;
  2550. fWithoutAlpha := tfLuminance8;
  2551. fOpenGLFormat := tfLuminance8;
  2552. fRange.r := $FF;
  2553. fRange.g := $FF;
  2554. fRange.b := $FF;
  2555. fglFormat := GL_LUMINANCE;
  2556. fglInternalFormat := GL_LUMINANCE8;
  2557. fglDataFormat := GL_UNSIGNED_BYTE;
  2558. end;
  2559. constructor TfdLuminance16.Create;
  2560. begin
  2561. inherited Create;
  2562. fPixelSize := 2.0;
  2563. fFormat := tfLuminance16;
  2564. fWithAlpha := tfLuminance16Alpha16;
  2565. fWithoutAlpha := tfLuminance16;
  2566. fOpenGLFormat := tfLuminance16;
  2567. fRange.r := $FFFF;
  2568. fRange.g := $FFFF;
  2569. fRange.b := $FFFF;
  2570. fglFormat := GL_LUMINANCE;
  2571. fglInternalFormat := GL_LUMINANCE16;
  2572. fglDataFormat := GL_UNSIGNED_SHORT;
  2573. end;
  2574. constructor TfdLuminance4Alpha4.Create;
  2575. begin
  2576. inherited Create;
  2577. fPixelSize := 2.0;
  2578. fFormat := tfLuminance4Alpha4;
  2579. fWithAlpha := tfLuminance4Alpha4;
  2580. fWithoutAlpha := tfLuminance4;
  2581. fOpenGLFormat := tfLuminance4Alpha4;
  2582. fRange.r := $FF;
  2583. fRange.g := $FF;
  2584. fRange.b := $FF;
  2585. fRange.a := $FF;
  2586. fShift.r := 0;
  2587. fShift.g := 0;
  2588. fShift.b := 0;
  2589. fShift.a := 8;
  2590. fglFormat := GL_LUMINANCE_ALPHA;
  2591. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2592. fglDataFormat := GL_UNSIGNED_BYTE;
  2593. end;
  2594. constructor TfdLuminance6Alpha2.Create;
  2595. begin
  2596. inherited Create;
  2597. fPixelSize := 2.0;
  2598. fFormat := tfLuminance6Alpha2;
  2599. fWithAlpha := tfLuminance6Alpha2;
  2600. fWithoutAlpha := tfLuminance8;
  2601. fOpenGLFormat := tfLuminance6Alpha2;
  2602. fRange.r := $FF;
  2603. fRange.g := $FF;
  2604. fRange.b := $FF;
  2605. fRange.a := $FF;
  2606. fShift.r := 0;
  2607. fShift.g := 0;
  2608. fShift.b := 0;
  2609. fShift.a := 8;
  2610. fglFormat := GL_LUMINANCE_ALPHA;
  2611. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2612. fglDataFormat := GL_UNSIGNED_BYTE;
  2613. end;
  2614. constructor TfdLuminance8Alpha8.Create;
  2615. begin
  2616. inherited Create;
  2617. fPixelSize := 2.0;
  2618. fFormat := tfLuminance8Alpha8;
  2619. fWithAlpha := tfLuminance8Alpha8;
  2620. fWithoutAlpha := tfLuminance8;
  2621. fOpenGLFormat := tfLuminance8Alpha8;
  2622. fRange.r := $FF;
  2623. fRange.g := $FF;
  2624. fRange.b := $FF;
  2625. fRange.a := $FF;
  2626. fShift.r := 0;
  2627. fShift.g := 0;
  2628. fShift.b := 0;
  2629. fShift.a := 8;
  2630. fglFormat := GL_LUMINANCE_ALPHA;
  2631. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2632. fglDataFormat := GL_UNSIGNED_BYTE;
  2633. end;
  2634. constructor TfdLuminance12Alpha4.Create;
  2635. begin
  2636. inherited Create;
  2637. fPixelSize := 4.0;
  2638. fFormat := tfLuminance12Alpha4;
  2639. fWithAlpha := tfLuminance12Alpha4;
  2640. fWithoutAlpha := tfLuminance16;
  2641. fOpenGLFormat := tfLuminance12Alpha4;
  2642. fRange.r := $FFFF;
  2643. fRange.g := $FFFF;
  2644. fRange.b := $FFFF;
  2645. fRange.a := $FFFF;
  2646. fShift.r := 0;
  2647. fShift.g := 0;
  2648. fShift.b := 0;
  2649. fShift.a := 16;
  2650. fglFormat := GL_LUMINANCE_ALPHA;
  2651. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2652. fglDataFormat := GL_UNSIGNED_SHORT;
  2653. end;
  2654. constructor TfdLuminance16Alpha16.Create;
  2655. begin
  2656. inherited Create;
  2657. fPixelSize := 4.0;
  2658. fFormat := tfLuminance16Alpha16;
  2659. fWithAlpha := tfLuminance16Alpha16;
  2660. fWithoutAlpha := tfLuminance16;
  2661. fOpenGLFormat := tfLuminance16Alpha16;
  2662. fRange.r := $FFFF;
  2663. fRange.g := $FFFF;
  2664. fRange.b := $FFFF;
  2665. fRange.a := $FFFF;
  2666. fShift.r := 0;
  2667. fShift.g := 0;
  2668. fShift.b := 0;
  2669. fShift.a := 16;
  2670. fglFormat := GL_LUMINANCE_ALPHA;
  2671. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2672. fglDataFormat := GL_UNSIGNED_SHORT;
  2673. end;
  2674. constructor TfdR3G3B2.Create;
  2675. begin
  2676. inherited Create;
  2677. fPixelSize := 1.0;
  2678. fFormat := tfR3G3B2;
  2679. fWithAlpha := tfRGBA4;
  2680. fWithoutAlpha := tfR3G3B2;
  2681. fOpenGLFormat := tfR3G3B2;
  2682. fRGBInverted := tfEmpty;
  2683. fRange.r := $07;
  2684. fRange.g := $07;
  2685. fRange.b := $04;
  2686. fShift.r := 5;
  2687. fShift.g := 2;
  2688. fShift.b := 0;
  2689. fglFormat := GL_RGB;
  2690. fglInternalFormat := GL_R3_G3_B2;
  2691. fglDataFormat := GL_UNSIGNED_BYTE_3_3_2;
  2692. end;
  2693. constructor TfdRGBX4.Create;
  2694. begin
  2695. inherited Create;
  2696. fPixelSize := 2.0;
  2697. fFormat := tfRGBX4;
  2698. fWithAlpha := tfRGBA4;
  2699. fWithoutAlpha := tfRGBX4;
  2700. fOpenGLFormat := tfRGBX4;
  2701. fRGBInverted := tfBGRX4;
  2702. fRange.r := $0F;
  2703. fRange.g := $0F;
  2704. fRange.b := $0F;
  2705. fRange.a := $00;
  2706. fShift.r := 12;
  2707. fShift.g := 8;
  2708. fShift.b := 4;
  2709. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2710. fglInternalFormat := GL_RGB4;
  2711. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2712. end;
  2713. constructor TfdXRGB4.Create;
  2714. begin
  2715. inherited Create;
  2716. fPixelSize := 2.0;
  2717. fFormat := tfXRGB4;
  2718. fWithAlpha := tfARGB4;
  2719. fWithoutAlpha := tfXRGB4;
  2720. fOpenGLFormat := tfXRGB4;
  2721. fRGBInverted := tfXBGR4;
  2722. fRange.r := $0F;
  2723. fRange.g := $0F;
  2724. fRange.b := $0F;
  2725. fShift.r := 8;
  2726. fShift.g := 4;
  2727. fShift.b := 0;
  2728. fglFormat := GL_BGRA;
  2729. fglInternalFormat := GL_RGB4;
  2730. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2731. end;
  2732. constructor TfdR5G6B5.Create;
  2733. begin
  2734. inherited Create;
  2735. fPixelSize := 2.0;
  2736. fFormat := tfR5G6B5;
  2737. fWithAlpha := tfRGB5A1;
  2738. fWithoutAlpha := tfR5G6B5;
  2739. fOpenGLFormat := tfR5G6B5;
  2740. fRGBInverted := tfB5G6R5;
  2741. fRange.r := $1F;
  2742. fRange.g := $3F;
  2743. fRange.b := $1F;
  2744. fShift.r := 11;
  2745. fShift.g := 5;
  2746. fShift.b := 0;
  2747. fglFormat := GL_RGB;
  2748. fglInternalFormat := GL_RGB565;
  2749. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2750. end;
  2751. constructor TfdRGB5X1.Create;
  2752. begin
  2753. inherited Create;
  2754. fPixelSize := 2.0;
  2755. fFormat := tfRGB5X1;
  2756. fWithAlpha := tfRGB5A1;
  2757. fWithoutAlpha := tfRGB5X1;
  2758. fOpenGLFormat := tfRGB5X1;
  2759. fRGBInverted := tfBGR5X1;
  2760. fRange.r := $1F;
  2761. fRange.g := $1F;
  2762. fRange.b := $1F;
  2763. fShift.r := 11;
  2764. fShift.g := 6;
  2765. fShift.b := 1;
  2766. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2767. fglInternalFormat := GL_RGB5;
  2768. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2769. end;
  2770. constructor TfdX1RGB5.Create;
  2771. begin
  2772. inherited Create;
  2773. fPixelSize := 2.0;
  2774. fFormat := tfX1RGB5;
  2775. fWithAlpha := tfA1RGB5;
  2776. fWithoutAlpha := tfX1RGB5;
  2777. fOpenGLFormat := tfX1RGB5;
  2778. fRGBInverted := tfX1BGR5;
  2779. fRange.r := $1F;
  2780. fRange.g := $1F;
  2781. fRange.b := $1F;
  2782. fShift.r := 10;
  2783. fShift.g := 5;
  2784. fShift.b := 0;
  2785. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2786. fglInternalFormat := GL_RGB5;
  2787. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2788. end;
  2789. constructor TfdRGB8.Create;
  2790. begin
  2791. inherited Create;
  2792. fPixelSize := 3.0;
  2793. fFormat := tfRGB8;
  2794. fWithAlpha := tfRGBA8;
  2795. fWithoutAlpha := tfRGB8;
  2796. fOpenGLFormat := tfRGB8;
  2797. fRGBInverted := tfBGR8;
  2798. fRange.r := $FF;
  2799. fRange.g := $FF;
  2800. fRange.b := $FF;
  2801. fShift.r := 16;
  2802. fShift.g := 8;
  2803. fShift.b := 0;
  2804. fglFormat := GL_BGR; // reverse byte order to match little endianess
  2805. fglInternalFormat := GL_RGB8; // as if u interpret the 3 bytes as unsigned integer
  2806. fglDataFormat := GL_UNSIGNED_BYTE;
  2807. end;
  2808. constructor TfdRGBX8.Create;
  2809. begin
  2810. inherited Create;
  2811. fPixelSize := 4.0;
  2812. fFormat := tfRGBX8;
  2813. fWithAlpha := tfRGBA8;
  2814. fWithoutAlpha := tfRGBX8;
  2815. fOpenGLFormat := tfRGB8;
  2816. fRGBInverted := tfBGRX8;
  2817. fRange.r := $FF;
  2818. fRange.g := $FF;
  2819. fRange.b := $FF;
  2820. fShift.r := 24;
  2821. fShift.g := 16;
  2822. fShift.b := 8;
  2823. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2824. fglInternalFormat := GL_RGB8;
  2825. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2826. end;
  2827. constructor TfdXRGB8.Create;
  2828. begin
  2829. inherited Create;
  2830. fPixelSize := 4.0;
  2831. fFormat := tfXRGB8;
  2832. fWithAlpha := tfXRGB8;
  2833. fWithoutAlpha := tfXRGB8;
  2834. fOpenGLFormat := tfRGB8;
  2835. fRGBInverted := tfXBGR8;
  2836. fRange.r := $FF;
  2837. fRange.g := $FF;
  2838. fRange.b := $FF;
  2839. fShift.r := 16;
  2840. fShift.g := 8;
  2841. fShift.b := 0;
  2842. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2843. fglInternalFormat := GL_RGB8;
  2844. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2845. end;
  2846. constructor TfdRGB10X2.Create;
  2847. begin
  2848. inherited Create;
  2849. fPixelSize := 3.0;
  2850. fFormat := tfRGB10X2;
  2851. fWithAlpha := tfRGB10A2;
  2852. fWithoutAlpha := tfRGB10X2;
  2853. fOpenGLFormat := tfRGB10X2;
  2854. fRGBInverted := tfBGR10X2;
  2855. fRange.r := $03FF;
  2856. fRange.g := $03FF;
  2857. fRange.b := $03FF;
  2858. fShift.r := 22;
  2859. fShift.g := 12;
  2860. fShift.b := 2;
  2861. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2862. fglInternalFormat := GL_RGB10;
  2863. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2864. end;
  2865. constructor TfdX2RGB10.Create;
  2866. begin
  2867. inherited Create;
  2868. fPixelSize := 3.0;
  2869. fFormat := tfX2RGB10;
  2870. fWithAlpha := tfA2RGB10;
  2871. fWithoutAlpha := tfX2RGB10;
  2872. fOpenGLFormat := tfX2RGB10;
  2873. fRGBInverted := tfX2BGR10;
  2874. fRange.r := $03FF;
  2875. fRange.g := $03FF;
  2876. fRange.b := $03FF;
  2877. fShift.r := 20;
  2878. fShift.g := 10;
  2879. fShift.b := 0;
  2880. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2881. fglInternalFormat := GL_RGB10;
  2882. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2883. end;
  2884. constructor TfdRGB16.Create;
  2885. begin
  2886. inherited Create;
  2887. fPixelSize := 6.0;
  2888. fFormat := tfRGB16;
  2889. fWithAlpha := tfRGBA16;
  2890. fWithoutAlpha := tfRGB16;
  2891. fOpenGLFormat := tfRGB16;
  2892. fRGBInverted := tfBGR16;
  2893. fRange.r := $FFFF;
  2894. fRange.g := $FFFF;
  2895. fRange.b := $FFFF;
  2896. fShift.r := 32;
  2897. fShift.g := 16;
  2898. fShift.b := 0;
  2899. fglFormat := GL_BGR; // reverse byte order to match little endianess
  2900. fglInternalFormat := GL_RGB16; // as if u interpret the 3 bytes as unsigned integer
  2901. fglDataFormat := GL_UNSIGNED_SHORT;
  2902. end;
  2903. constructor TfdRGBA4.Create;
  2904. begin
  2905. inherited Create;
  2906. fPixelSize := 2.0;
  2907. fFormat := tfRGBA4;
  2908. fWithAlpha := tfRGBA4;
  2909. fWithoutAlpha := tfRGBX4;
  2910. fOpenGLFormat := tfRGBA4;
  2911. fRGBInverted := tfBGRA4;
  2912. fRange.r := $0F;
  2913. fRange.g := $0F;
  2914. fRange.b := $0F;
  2915. fRange.a := $0F;
  2916. fShift.r := 12;
  2917. fShift.g := 8;
  2918. fShift.b := 4;
  2919. fShift.a := 0;
  2920. fglFormat := GL_RGBA;
  2921. fglInternalFormat := GL_RGBA4;
  2922. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2923. end;
  2924. constructor TfdARGB4.Create;
  2925. begin
  2926. inherited Create;
  2927. fPixelSize := 2.0;
  2928. fFormat := tfARGB4;
  2929. fWithAlpha := tfARGB4;
  2930. fWithoutAlpha := tfXRGB4;
  2931. fOpenGLFormat := tfARGB4;
  2932. fRGBInverted := tfABGR4;
  2933. fRange.r := $0F;
  2934. fRange.g := $0F;
  2935. fRange.b := $0F;
  2936. fRange.a := $0F;
  2937. fShift.r := 8;
  2938. fShift.g := 4;
  2939. fShift.b := 0;
  2940. fShift.a := 12;
  2941. fglFormat := GL_BGRA;
  2942. fglInternalFormat := GL_RGBA4;
  2943. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2944. end;
  2945. constructor TfdRGB5A1.Create;
  2946. begin
  2947. inherited Create;
  2948. fPixelSize := 2.0;
  2949. fFormat := tfRGB5A1;
  2950. fWithAlpha := tfRGB5A1;
  2951. fWithoutAlpha := tfRGB5X1;
  2952. fOpenGLFormat := tfRGB5A1;
  2953. fRGBInverted := tfBGR5A1;
  2954. fRange.r := $1F;
  2955. fRange.g := $1F;
  2956. fRange.b := $1F;
  2957. fRange.a := $01;
  2958. fShift.r := 11;
  2959. fShift.g := 6;
  2960. fShift.b := 1;
  2961. fShift.a := 0;
  2962. fglFormat := GL_RGBA;
  2963. fglInternalFormat := GL_RGB5_A1;
  2964. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2965. end;
  2966. constructor TfdA1RGB5.Create;
  2967. begin
  2968. inherited Create;
  2969. fPixelSize := 2.0;
  2970. fFormat := tfA1RGB5;
  2971. fWithAlpha := tfA1RGB5;
  2972. fWithoutAlpha := tfX1RGB5;
  2973. fOpenGLFormat := tfA1RGB5;
  2974. fRGBInverted := tfA1BGR5;
  2975. fRange.r := $1F;
  2976. fRange.g := $1F;
  2977. fRange.b := $1F;
  2978. fRange.a := $01;
  2979. fShift.r := 10;
  2980. fShift.g := 5;
  2981. fShift.b := 0;
  2982. fShift.a := 15;
  2983. fglFormat := GL_BGRA;
  2984. fglInternalFormat := GL_RGB5_A1;
  2985. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2986. end;
  2987. constructor TfdRGBA8.Create;
  2988. begin
  2989. inherited Create;
  2990. fPixelSize := 4.0;
  2991. fFormat := tfRGBA8;
  2992. fWithAlpha := tfRGBA8;
  2993. fWithoutAlpha := tfRGB8;
  2994. fOpenGLFormat := tfRGBA8;
  2995. fRGBInverted := tfBGRA8;
  2996. fRange.r := $FF;
  2997. fRange.g := $FF;
  2998. fRange.b := $FF;
  2999. fRange.a := $FF;
  3000. fShift.r := 24;
  3001. fShift.g := 16;
  3002. fShift.b := 8;
  3003. fShift.a := 0;
  3004. fglFormat := GL_RGBA;
  3005. fglInternalFormat := GL_RGBA8;
  3006. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3007. end;
  3008. constructor TfdARGB8.Create;
  3009. begin
  3010. inherited Create;
  3011. fPixelSize := 4.0;
  3012. fFormat := tfARGB8;
  3013. fWithAlpha := tfARGB8;
  3014. fWithoutAlpha := tfRGB8;
  3015. fOpenGLFormat := tfARGB8;
  3016. fRGBInverted := tfABGR8;
  3017. fRange.r := $FF;
  3018. fRange.g := $FF;
  3019. fRange.b := $FF;
  3020. fRange.a := $FF;
  3021. fShift.r := 16;
  3022. fShift.g := 8;
  3023. fShift.b := 0;
  3024. fShift.a := 24;
  3025. fglFormat := GL_BGRA;
  3026. fglInternalFormat := GL_RGBA8;
  3027. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3028. end;
  3029. constructor TfdRGB10A2.Create;
  3030. begin
  3031. inherited Create;
  3032. fPixelSize := 3.0;
  3033. fFormat := tfRGB10A2;
  3034. fWithAlpha := tfRGB10A2;
  3035. fWithoutAlpha := tfRGB10X2;
  3036. fOpenGLFormat := tfRGB10A2;
  3037. fRGBInverted := tfBGR10A2;
  3038. fRange.r := $03FF;
  3039. fRange.g := $03FF;
  3040. fRange.b := $03FF;
  3041. fRange.a := $0003;
  3042. fShift.r := 22;
  3043. fShift.g := 12;
  3044. fShift.b := 2;
  3045. fShift.a := 0;
  3046. fglFormat := GL_RGBA;
  3047. fglInternalFormat := GL_RGB10_A2;
  3048. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3049. end;
  3050. constructor TfdA2RGB10.Create;
  3051. begin
  3052. inherited Create;
  3053. fPixelSize := 3.0;
  3054. fFormat := tfA2RGB10;
  3055. fWithAlpha := tfA2RGB10;
  3056. fWithoutAlpha := tfX2RGB10;
  3057. fOpenGLFormat := tfA2RGB10;
  3058. fRGBInverted := tfA2BGR10;
  3059. fRange.r := $03FF;
  3060. fRange.g := $03FF;
  3061. fRange.b := $03FF;
  3062. fRange.a := $0003;
  3063. fShift.r := 20;
  3064. fShift.g := 10;
  3065. fShift.b := 0;
  3066. fShift.a := 30;
  3067. fglFormat := GL_BGRA;
  3068. fglInternalFormat := GL_RGB10_A2;
  3069. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3070. end;
  3071. constructor TfdRGBA16.Create;
  3072. begin
  3073. inherited Create;
  3074. fPixelSize := 8.0;
  3075. fFormat := tfRGBA16;
  3076. fWithAlpha := tfRGBA16;
  3077. fWithoutAlpha := tfRGB16;
  3078. fOpenGLFormat := tfRGBA16;
  3079. fRGBInverted := tfBGRA16;
  3080. fRange.r := $FFFF;
  3081. fRange.g := $FFFF;
  3082. fRange.b := $FFFF;
  3083. fRange.a := $FFFF;
  3084. fShift.r := 48;
  3085. fShift.g := 32;
  3086. fShift.b := 16;
  3087. fShift.a := 0;
  3088. fglFormat := GL_BGRA; // reverse byte order to match little endianess
  3089. fglInternalFormat := GL_RGBA16; // as if u interpret the 3 bytes as unsigned integer
  3090. fglDataFormat := GL_UNSIGNED_SHORT;
  3091. end;
  3092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3093. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3095. constructor TfdBGRX4.Create;
  3096. begin
  3097. inherited Create;
  3098. fPixelSize := 2.0;
  3099. fFormat := tfBGRX4;
  3100. fWithAlpha := tfBGRA4;
  3101. fWithoutAlpha := tfBGRX4;
  3102. fOpenGLFormat := tfBGRX4;
  3103. fRGBInverted := tfRGBX4;
  3104. fRange.r := $0F;
  3105. fRange.g := $0F;
  3106. fRange.b := $0F;
  3107. fShift.r := 4;
  3108. fShift.g := 8;
  3109. fShift.b := 12;
  3110. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3111. fglInternalFormat := GL_RGB4;
  3112. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3113. end;
  3114. constructor TfdXBGR4.Create;
  3115. begin
  3116. inherited Create;
  3117. fPixelSize := 2.0;
  3118. fFormat := tfXBGR4;
  3119. fWithAlpha := tfABGR4;
  3120. fWithoutAlpha := tfXBGR4;
  3121. fOpenGLFormat := tfXBGR4;
  3122. fRGBInverted := tfXRGB4;
  3123. fRange.r := $0F;
  3124. fRange.g := $0F;
  3125. fRange.b := $0F;
  3126. fRange.a := $0F;
  3127. fShift.r := 0;
  3128. fShift.g := 4;
  3129. fShift.b := 8;
  3130. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3131. fglInternalFormat := GL_RGB4;
  3132. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3133. end;
  3134. constructor TfdB5G6R5.Create;
  3135. begin
  3136. inherited Create;
  3137. fPixelSize := 2.0;
  3138. fFormat := tfB5G6R5;
  3139. fWithAlpha := tfBGR5A1;
  3140. fWithoutAlpha := tfB5G6R5;
  3141. fOpenGLFormat := tfB5G6R5;
  3142. fRGBInverted := tfR5G6B5;
  3143. fRange.r := $1F;
  3144. fRange.g := $3F;
  3145. fRange.b := $1F;
  3146. fShift.r := 0;
  3147. fShift.g := 5;
  3148. fShift.b := 11;
  3149. fglFormat := GL_RGB;
  3150. fglInternalFormat := GL_RGB565;
  3151. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  3152. end;
  3153. constructor TfdBGR5X1.Create;
  3154. begin
  3155. inherited Create;
  3156. fPixelSize := 2.0;
  3157. fFormat := tfBGR5X1;
  3158. fWithAlpha := tfBGR5A1;
  3159. fWithoutAlpha := tfBGR5X1;
  3160. fOpenGLFormat := tfBGR5X1;
  3161. fRGBInverted := tfRGB5X1;
  3162. fRange.r := $1F;
  3163. fRange.g := $1F;
  3164. fRange.b := $1F;
  3165. fShift.r := 1;
  3166. fShift.g := 6;
  3167. fShift.b := 11;
  3168. fglFormat := GL_BGRA;
  3169. fglInternalFormat := GL_RGB5;
  3170. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3171. end;
  3172. constructor TfdX1BGR5.Create;
  3173. begin
  3174. inherited Create;
  3175. fPixelSize := 2.0;
  3176. fFormat := tfX1BGR5;
  3177. fWithAlpha := tfA1BGR5;
  3178. fWithoutAlpha := tfX1BGR5;
  3179. fOpenGLFormat := tfX1BGR5;
  3180. fRGBInverted := tfX1RGB5;
  3181. fRange.r := $1F;
  3182. fRange.g := $1F;
  3183. fRange.b := $1F;
  3184. fShift.r := 0;
  3185. fShift.g := 5;
  3186. fShift.b := 10;
  3187. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3188. fglInternalFormat := GL_RGB5;
  3189. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3190. end;
  3191. constructor TfdBGR8.Create;
  3192. begin
  3193. inherited Create;
  3194. fPixelSize := 3.0;
  3195. fFormat := tfBGR8;
  3196. fWithAlpha := tfBGRA8;
  3197. fWithoutAlpha := tfBGR8;
  3198. fOpenGLFormat := tfBGR8;
  3199. fRGBInverted := tfRGB8;
  3200. fRange.r := $FF;
  3201. fRange.g := $FF;
  3202. fRange.b := $FF;
  3203. fShift.r := 0;
  3204. fShift.g := 8;
  3205. fShift.b := 16;
  3206. fglFormat := GL_RGB; // reverse byte order to match little endianess
  3207. fglInternalFormat := GL_RGB8; // as if u interpret the 3 bytes as unsigned integer
  3208. fglDataFormat := GL_UNSIGNED_BYTE;
  3209. end;
  3210. constructor TfdBGRX8.Create;
  3211. begin
  3212. inherited Create;
  3213. fPixelSize := 4.0;
  3214. fFormat := tfBGRX8;
  3215. fWithAlpha := tfBGRA8;
  3216. fWithoutAlpha := tfBGRX8;
  3217. fOpenGLFormat := tfBGRX8;
  3218. fRGBInverted := tfRGBX8;
  3219. fRange.r := $FF;
  3220. fRange.g := $FF;
  3221. fRange.b := $FF;
  3222. fShift.r := 8;
  3223. fShift.g := 16;
  3224. fShift.b := 24;
  3225. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3226. fglInternalFormat := GL_RGB8;
  3227. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3228. end;
  3229. constructor TfdXBGR8.Create;
  3230. begin
  3231. inherited Create;
  3232. fPixelSize := 4.0;
  3233. fFormat := tfXBGR8;
  3234. fWithAlpha := tfABGR8;
  3235. fWithoutAlpha := tfXBGR8;
  3236. fOpenGLFormat := tfXBGR8;
  3237. fRGBInverted := tfXRGB8;
  3238. fRange.r := $FF;
  3239. fRange.g := $FF;
  3240. fRange.b := $FF;
  3241. fShift.r := 0;
  3242. fShift.g := 8;
  3243. fShift.b := 16;
  3244. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3245. fglInternalFormat := GL_RGB8;
  3246. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3247. end;
  3248. constructor TfdBGR10X2.Create;
  3249. begin
  3250. inherited Create;
  3251. fPixelSize := 3.0;
  3252. fFormat := tfBGR10X2;
  3253. fWithAlpha := tfBGR10A2;
  3254. fWithoutAlpha := tfBGR10X2;
  3255. fOpenGLFormat := tfBGR10X2;
  3256. fRGBInverted := tfRGB10X2;
  3257. fRange.r := $03FF;
  3258. fRange.g := $03FF;
  3259. fRange.b := $03FF;
  3260. fShift.r := 2;
  3261. fShift.g := 12;
  3262. fShift.b := 22;
  3263. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3264. fglInternalFormat := GL_RGB10;
  3265. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3266. end;
  3267. constructor TfdX2BGR10.Create;
  3268. begin
  3269. inherited Create;
  3270. fPixelSize := 3.0;
  3271. fFormat := tfX2BGR10;
  3272. fWithAlpha := tfA2BGR10;
  3273. fWithoutAlpha := tfX2BGR10;
  3274. fOpenGLFormat := tfX2BGR10;
  3275. fRGBInverted := tfX2RGB10;
  3276. fRange.r := $03FF;
  3277. fRange.g := $03FF;
  3278. fRange.b := $03FF;
  3279. fShift.r := 0;
  3280. fShift.g := 10;
  3281. fShift.b := 20;
  3282. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3283. fglInternalFormat := GL_RGB10;
  3284. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3285. end;
  3286. constructor TfdBGR16.Create;
  3287. begin
  3288. inherited Create;
  3289. fPixelSize := 6.0;
  3290. fFormat := tfBGR16;
  3291. fWithAlpha := tfBGRA16;
  3292. fWithoutAlpha := tfBGR16;
  3293. fOpenGLFormat := tfBGR16;
  3294. fRGBInverted := tfRGB16;
  3295. fRange.r := $FFFF;
  3296. fRange.g := $FFFF;
  3297. fRange.b := $FFFF;
  3298. fShift.r := 0;
  3299. fShift.g := 16;
  3300. fShift.b := 32;
  3301. fglFormat := GL_RGB; // reverse byte order to match little endianess
  3302. fglInternalFormat := GL_RGB16; // as if u interpret the 3 bytes as unsigned integer
  3303. fglDataFormat := GL_UNSIGNED_SHORT;
  3304. end;
  3305. constructor TfdBGRA4.Create;
  3306. begin
  3307. inherited Create;
  3308. fPixelSize := 2.0;
  3309. fFormat := tfBGRA4;
  3310. fWithAlpha := tfBGRA4;
  3311. fWithoutAlpha := tfBGRX4;
  3312. fOpenGLFormat := tfBGRA4;
  3313. fRGBInverted := tfRGBA4;
  3314. fRange.r := $0F;
  3315. fRange.g := $0F;
  3316. fRange.b := $0F;
  3317. fRange.a := $0F;
  3318. fShift.r := 4;
  3319. fShift.g := 8;
  3320. fShift.b := 12;
  3321. fShift.a := 0;
  3322. fglFormat := GL_BGRA;
  3323. fglInternalFormat := GL_RGBA4;
  3324. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3325. end;
  3326. constructor TfdABGR4.Create;
  3327. begin
  3328. inherited Create;
  3329. fPixelSize := 2.0;
  3330. fFormat := tfABGR4;
  3331. fWithAlpha := tfABGR4;
  3332. fWithoutAlpha := tfXBGR4;
  3333. fOpenGLFormat := tfABGR4;
  3334. fRGBInverted := tfARGB4;
  3335. fRange.r := $0F;
  3336. fRange.g := $0F;
  3337. fRange.b := $0F;
  3338. fRange.a := $0F;
  3339. fShift.r := 0;
  3340. fShift.g := 4;
  3341. fShift.b := 8;
  3342. fShift.a := 12;
  3343. fglFormat := GL_RGBA;
  3344. fglInternalFormat := GL_RGBA4;
  3345. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3346. end;
  3347. constructor TfdBGR5A1.Create;
  3348. begin
  3349. inherited Create;
  3350. fPixelSize := 2.0;
  3351. fFormat := tfBGR5A1;
  3352. fWithAlpha := tfBGR5A1;
  3353. fWithoutAlpha := tfBGR5X1;
  3354. fOpenGLFormat := tfBGR5A1;
  3355. fRGBInverted := tfRGB5A1;
  3356. fRange.r := $1F;
  3357. fRange.g := $1F;
  3358. fRange.b := $1F;
  3359. fRange.a := $01;
  3360. fShift.r := 1;
  3361. fShift.g := 6;
  3362. fShift.b := 11;
  3363. fShift.a := 0;
  3364. fglFormat := GL_BGRA;
  3365. fglInternalFormat := GL_RGB5_A1;
  3366. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3367. end;
  3368. constructor TfdA1BGR5.Create;
  3369. begin
  3370. inherited Create;
  3371. fPixelSize := 2.0;
  3372. fFormat := tfA1BGR5;
  3373. fWithAlpha := tfA1BGR5;
  3374. fWithoutAlpha := tfX1BGR5;
  3375. fOpenGLFormat := tfA1BGR5;
  3376. fRGBInverted := tfA1RGB5;
  3377. fRange.r := $1F;
  3378. fRange.g := $1F;
  3379. fRange.b := $1F;
  3380. fRange.a := $01;
  3381. fShift.r := 0;
  3382. fShift.g := 5;
  3383. fShift.b := 10;
  3384. fShift.a := 15;
  3385. fglFormat := GL_RGBA;
  3386. fglInternalFormat := GL_RGB5_A1;
  3387. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3388. end;
  3389. constructor TfdBGRA8.Create;
  3390. begin
  3391. inherited Create;
  3392. fPixelSize := 4.0;
  3393. fFormat := tfBGRA8;
  3394. fWithAlpha := tfBGRA8;
  3395. fWithoutAlpha := tfBGR8;
  3396. fOpenGLFormat := tfBGRA8;
  3397. fRGBInverted := tfRGBA8;
  3398. fRange.r := $FF;
  3399. fRange.g := $FF;
  3400. fRange.b := $FF;
  3401. fRange.a := $FF;
  3402. fShift.r := 8;
  3403. fShift.g := 16;
  3404. fShift.b := 24;
  3405. fShift.a := 0;
  3406. fglFormat := GL_BGRA;
  3407. fglInternalFormat := GL_RGBA8;
  3408. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3409. end;
  3410. constructor TfdABGR8.Create;
  3411. begin
  3412. inherited Create;
  3413. fPixelSize := 4.0;
  3414. fFormat := tfABGR8;
  3415. fWithAlpha := tfABGR8;
  3416. fWithoutAlpha := tfBGR8;
  3417. fOpenGLFormat := tfABGR8;
  3418. fRGBInverted := tfARGB8;
  3419. fRange.r := $FF;
  3420. fRange.g := $FF;
  3421. fRange.b := $FF;
  3422. fRange.a := $FF;
  3423. fShift.r := 0;
  3424. fShift.g := 8;
  3425. fShift.b := 16;
  3426. fShift.a := 24;
  3427. fglFormat := GL_RGBA;
  3428. fglInternalFormat := GL_RGBA8;
  3429. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3430. end;
  3431. constructor TfdBGR10A2.Create;
  3432. begin
  3433. inherited Create;
  3434. fPixelSize := 3.0;
  3435. fFormat := tfBGR10A2;
  3436. fWithAlpha := tfBGR10A2;
  3437. fWithoutAlpha := tfBGR10X2;
  3438. fOpenGLFormat := tfBGR10A2;
  3439. fRGBInverted := tfRGB10A2;
  3440. fRange.r := $03FF;
  3441. fRange.g := $03FF;
  3442. fRange.b := $03FF;
  3443. fRange.a := $0003;
  3444. fShift.r := 2;
  3445. fShift.g := 12;
  3446. fShift.b := 22;
  3447. fShift.a := 0;
  3448. fglFormat := GL_BGRA;
  3449. fglInternalFormat := GL_RGB10_A2;
  3450. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3451. end;
  3452. constructor TfdA2BGR10.Create;
  3453. begin
  3454. inherited Create;
  3455. fPixelSize := 3.0;
  3456. fFormat := tfA2BGR10;
  3457. fWithAlpha := tfA2BGR10;
  3458. fWithoutAlpha := tfX2BGR10;
  3459. fOpenGLFormat := tfA2BGR10;
  3460. fRGBInverted := tfA2RGB10;
  3461. fRange.r := $03FF;
  3462. fRange.g := $03FF;
  3463. fRange.b := $03FF;
  3464. fRange.a := $0003;
  3465. fShift.r := 0;
  3466. fShift.g := 10;
  3467. fShift.b := 20;
  3468. fShift.a := 30;
  3469. fglFormat := GL_RGBA;
  3470. fglInternalFormat := GL_RGB10_A2;
  3471. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3472. end;
  3473. constructor TfdBGRA16.Create;
  3474. begin
  3475. inherited Create;
  3476. fPixelSize := 8.0;
  3477. fFormat := tfBGRA16;
  3478. fWithAlpha := tfBGRA16;
  3479. fWithoutAlpha := tfBGR16;
  3480. fOpenGLFormat := tfBGRA16;
  3481. fRGBInverted := tfRGBA16;
  3482. fRange.r := $FFFF;
  3483. fRange.g := $FFFF;
  3484. fRange.b := $FFFF;
  3485. fRange.a := $FFFF;
  3486. fShift.r := 16;
  3487. fShift.g := 32;
  3488. fShift.b := 48;
  3489. fShift.a := 0;
  3490. fglFormat := GL_RGBA; // reverse byte order to match little endianess
  3491. fglInternalFormat := GL_RGBA16; // as if u interpret the 3 bytes as unsigned integer
  3492. fglDataFormat := GL_UNSIGNED_SHORT;
  3493. end;
  3494. constructor TfdDepth16.Create;
  3495. begin
  3496. inherited Create;
  3497. fPixelSize := 2.0;
  3498. fFormat := tfDepth16;
  3499. fWithoutAlpha := tfDepth16;
  3500. fOpenGLFormat := tfDepth16;
  3501. fRange.r := $FFFF;
  3502. fRange.g := $FFFF;
  3503. fRange.b := $FFFF;
  3504. fRange.a := $FFFF;
  3505. fglFormat := GL_DEPTH_COMPONENT;
  3506. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3507. fglDataFormat := GL_UNSIGNED_SHORT;
  3508. end;
  3509. constructor TfdDepth24.Create;
  3510. begin
  3511. inherited Create;
  3512. fPixelSize := 3.0;
  3513. fFormat := tfDepth24;
  3514. fWithoutAlpha := tfDepth24;
  3515. fOpenGLFormat := tfDepth24;
  3516. fRange.r := $FFFFFF;
  3517. fRange.g := $FFFFFF;
  3518. fRange.b := $FFFFFF;
  3519. fRange.a := $FFFFFF;
  3520. fglFormat := GL_DEPTH_COMPONENT;
  3521. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3522. fglDataFormat := GL_UNSIGNED_INT;
  3523. end;
  3524. constructor TfdDepth32.Create;
  3525. begin
  3526. inherited Create;
  3527. fPixelSize := 4.0;
  3528. fFormat := tfDepth32;
  3529. fWithoutAlpha := tfDepth32;
  3530. fOpenGLFormat := tfDepth32;
  3531. fRange.r := $FFFFFFFF;
  3532. fRange.g := $FFFFFFFF;
  3533. fRange.b := $FFFFFFFF;
  3534. fRange.a := $FFFFFFFF;
  3535. fglFormat := GL_DEPTH_COMPONENT;
  3536. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3537. fglDataFormat := GL_UNSIGNED_INT;
  3538. end;
  3539. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3540. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3541. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3542. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3543. begin
  3544. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3545. end;
  3546. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3547. begin
  3548. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3549. end;
  3550. constructor TfdS3tcDtx1RGBA.Create;
  3551. begin
  3552. inherited Create;
  3553. fFormat := tfS3tcDtx1RGBA;
  3554. fWithAlpha := tfS3tcDtx1RGBA;
  3555. fOpenGLFormat := tfS3tcDtx1RGBA;
  3556. fUncompressed := tfRGB5A1;
  3557. fPixelSize := 0.5;
  3558. fIsCompressed := true;
  3559. fglFormat := GL_COMPRESSED_RGBA;
  3560. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3561. fglDataFormat := GL_UNSIGNED_BYTE;
  3562. end;
  3563. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3564. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3565. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3566. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3567. begin
  3568. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3569. end;
  3570. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3571. begin
  3572. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3573. end;
  3574. constructor TfdS3tcDtx3RGBA.Create;
  3575. begin
  3576. inherited Create;
  3577. fFormat := tfS3tcDtx3RGBA;
  3578. fWithAlpha := tfS3tcDtx3RGBA;
  3579. fOpenGLFormat := tfS3tcDtx3RGBA;
  3580. fUncompressed := tfRGBA8;
  3581. fPixelSize := 1.0;
  3582. fIsCompressed := true;
  3583. fglFormat := GL_COMPRESSED_RGBA;
  3584. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3585. fglDataFormat := GL_UNSIGNED_BYTE;
  3586. end;
  3587. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3588. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3589. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3590. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3591. begin
  3592. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3593. end;
  3594. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3595. begin
  3596. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3597. end;
  3598. constructor TfdS3tcDtx5RGBA.Create;
  3599. begin
  3600. inherited Create;
  3601. fFormat := tfS3tcDtx3RGBA;
  3602. fWithAlpha := tfS3tcDtx3RGBA;
  3603. fOpenGLFormat := tfS3tcDtx3RGBA;
  3604. fUncompressed := tfRGBA8;
  3605. fPixelSize := 1.0;
  3606. fIsCompressed := true;
  3607. fglFormat := GL_COMPRESSED_RGBA;
  3608. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3609. fglDataFormat := GL_UNSIGNED_BYTE;
  3610. end;
  3611. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3612. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3613. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3614. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3615. var
  3616. f: TglBitmapFormat;
  3617. begin
  3618. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3619. result := TFormatDescriptor.Get(f);
  3620. if (result.glInternalFormat = aInternalFormat) then
  3621. exit;
  3622. end;
  3623. result := TFormatDescriptor.Get(tfEmpty);
  3624. end;
  3625. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3626. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3627. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3628. class procedure TFormatDescriptor.Init;
  3629. begin
  3630. if not Assigned(FormatDescriptorCS) then
  3631. FormatDescriptorCS := TCriticalSection.Create;
  3632. end;
  3633. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3634. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3635. begin
  3636. FormatDescriptorCS.Enter;
  3637. try
  3638. result := FormatDescriptors[aFormat];
  3639. if not Assigned(result) then begin
  3640. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3641. FormatDescriptors[aFormat] := result;
  3642. end;
  3643. finally
  3644. FormatDescriptorCS.Leave;
  3645. end;
  3646. end;
  3647. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3648. class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3649. begin
  3650. result := Get(Get(aFormat).WithAlpha);
  3651. end;
  3652. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3653. class procedure TFormatDescriptor.Clear;
  3654. var
  3655. f: TglBitmapFormat;
  3656. begin
  3657. FormatDescriptorCS.Enter;
  3658. try
  3659. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3660. FreeAndNil(FormatDescriptors[f]);
  3661. finally
  3662. FormatDescriptorCS.Leave;
  3663. end;
  3664. end;
  3665. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3666. class procedure TFormatDescriptor.Finalize;
  3667. begin
  3668. Clear;
  3669. FreeAndNil(FormatDescriptorCS);
  3670. end;
  3671. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3672. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3673. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3674. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3675. begin
  3676. Update(aValue, fRange.r, fShift.r);
  3677. end;
  3678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3679. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3680. begin
  3681. Update(aValue, fRange.g, fShift.g);
  3682. end;
  3683. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3684. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3685. begin
  3686. Update(aValue, fRange.b, fShift.b);
  3687. end;
  3688. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3689. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3690. begin
  3691. Update(aValue, fRange.a, fShift.a);
  3692. end;
  3693. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3694. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3695. aShift: Byte);
  3696. begin
  3697. aShift := 0;
  3698. aRange := 0;
  3699. if (aMask = 0) then
  3700. exit;
  3701. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3702. inc(aShift);
  3703. aMask := aMask shr 1;
  3704. end;
  3705. aRange := 1;
  3706. while (aMask > 0) do begin
  3707. aRange := aRange shl 1;
  3708. aMask := aMask shr 1;
  3709. end;
  3710. dec(aRange);
  3711. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3712. end;
  3713. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3714. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3715. var
  3716. data: QWord;
  3717. s: Integer;
  3718. begin
  3719. data :=
  3720. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3721. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3722. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3723. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3724. s := Round(fPixelSize);
  3725. case s of
  3726. 1: aData^ := data;
  3727. 2: PWord(aData)^ := data;
  3728. 4: PCardinal(aData)^ := data;
  3729. 8: PQWord(aData)^ := data;
  3730. else
  3731. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3732. end;
  3733. inc(aData, s);
  3734. end;
  3735. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3736. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3737. var
  3738. data: QWord;
  3739. s, i: Integer;
  3740. begin
  3741. s := Round(fPixelSize);
  3742. case s of
  3743. 1: data := aData^;
  3744. 2: data := PWord(aData)^;
  3745. 4: data := PCardinal(aData)^;
  3746. 8: data := PQWord(aData)^;
  3747. else
  3748. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3749. end;
  3750. for i := 0 to 3 do
  3751. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3752. inc(aData, s);
  3753. end;
  3754. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3755. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3756. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3757. procedure TbmpColorTableFormat.CreateColorTable;
  3758. var
  3759. i: Integer;
  3760. begin
  3761. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3762. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3763. if (Format = tfLuminance4) then
  3764. SetLength(fColorTable, 16)
  3765. else
  3766. SetLength(fColorTable, 256);
  3767. case Format of
  3768. tfLuminance4: begin
  3769. for i := 0 to High(fColorTable) do begin
  3770. fColorTable[i].r := 16 * i;
  3771. fColorTable[i].g := 16 * i;
  3772. fColorTable[i].b := 16 * i;
  3773. fColorTable[i].a := 0;
  3774. end;
  3775. end;
  3776. tfLuminance8: begin
  3777. for i := 0 to High(fColorTable) do begin
  3778. fColorTable[i].r := i;
  3779. fColorTable[i].g := i;
  3780. fColorTable[i].b := i;
  3781. fColorTable[i].a := 0;
  3782. end;
  3783. end;
  3784. tfR3G3B2: begin
  3785. for i := 0 to High(fColorTable) do begin
  3786. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3787. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3788. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3789. fColorTable[i].a := 0;
  3790. end;
  3791. end;
  3792. end;
  3793. end;
  3794. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3795. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3796. var
  3797. d: Byte;
  3798. begin
  3799. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3800. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3801. case Format of
  3802. tfLuminance4: begin
  3803. if (aMapData = nil) then
  3804. aData^ := 0;
  3805. d := LuminanceWeight(aPixel) and Range.r;
  3806. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3807. inc(PByte(aMapData), 4);
  3808. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3809. inc(aData);
  3810. aMapData := nil;
  3811. end;
  3812. end;
  3813. tfLuminance8: begin
  3814. aData^ := LuminanceWeight(aPixel) and Range.r;
  3815. inc(aData);
  3816. end;
  3817. tfR3G3B2: begin
  3818. aData^ := Round(
  3819. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3820. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3821. ((aPixel.Data.b and Range.b) shl Shift.b));
  3822. inc(aData);
  3823. end;
  3824. end;
  3825. end;
  3826. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3827. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3828. var
  3829. idx: QWord;
  3830. s: Integer;
  3831. bits: Byte;
  3832. f: Single;
  3833. begin
  3834. s := Trunc(fPixelSize);
  3835. f := fPixelSize - s;
  3836. bits := Round(8 * f);
  3837. case s of
  3838. 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
  3839. 1: idx := aData^;
  3840. 2: idx := PWord(aData)^;
  3841. 4: idx := PCardinal(aData)^;
  3842. 8: idx := PQWord(aData)^;
  3843. else
  3844. raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3845. end;
  3846. if (idx >= Length(fColorTable)) then
  3847. raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
  3848. with fColorTable[idx] do begin
  3849. aPixel.Data.r := r;
  3850. aPixel.Data.g := g;
  3851. aPixel.Data.b := b;
  3852. aPixel.Data.a := a;
  3853. end;
  3854. inc(PByte(aMapData), bits);
  3855. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3856. inc(aData, 1);
  3857. dec(PByte(aMapData), 8);
  3858. end;
  3859. inc(aData, s);
  3860. end;
  3861. destructor TbmpColorTableFormat.Destroy;
  3862. begin
  3863. SetLength(fColorTable, 0);
  3864. inherited Destroy;
  3865. end;
  3866. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3867. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3868. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3869. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3870. var
  3871. i: Integer;
  3872. begin
  3873. for i := 0 to 3 do begin
  3874. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3875. if (aSourceFD.Range.arr[i] > 0) then
  3876. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3877. else
  3878. aPixel.Data.arr[i] := 0;
  3879. end;
  3880. end;
  3881. end;
  3882. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3883. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3884. begin
  3885. with aFuncRec do begin
  3886. if (Source.Range.r > 0) then
  3887. Dest.Data.r := Source.Data.r;
  3888. if (Source.Range.g > 0) then
  3889. Dest.Data.g := Source.Data.g;
  3890. if (Source.Range.b > 0) then
  3891. Dest.Data.b := Source.Data.b;
  3892. if (Source.Range.a > 0) then
  3893. Dest.Data.a := Source.Data.a;
  3894. end;
  3895. end;
  3896. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3897. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3898. var
  3899. i: Integer;
  3900. begin
  3901. with aFuncRec do begin
  3902. for i := 0 to 3 do
  3903. if (Source.Range.arr[i] > 0) then
  3904. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3905. end;
  3906. end;
  3907. type
  3908. TShiftData = packed record
  3909. case Integer of
  3910. 0: (r, g, b, a: SmallInt);
  3911. 1: (arr: array[0..3] of SmallInt);
  3912. end;
  3913. PShiftData = ^TShiftData;
  3914. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3915. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3916. var
  3917. i: Integer;
  3918. begin
  3919. with aFuncRec do
  3920. for i := 0 to 3 do
  3921. if (Source.Range.arr[i] > 0) then
  3922. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3923. end;
  3924. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3925. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3926. begin
  3927. with aFuncRec do begin
  3928. Dest.Data := Source.Data;
  3929. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3930. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3931. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3932. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3933. end;
  3934. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3935. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3936. end;
  3937. end;
  3938. end;
  3939. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3940. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3941. var
  3942. i: Integer;
  3943. begin
  3944. with aFuncRec do begin
  3945. for i := 0 to 3 do
  3946. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3947. end;
  3948. end;
  3949. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3950. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3951. var
  3952. Temp: Single;
  3953. begin
  3954. with FuncRec do begin
  3955. if (FuncRec.Args = nil) then begin //source has no alpha
  3956. Temp :=
  3957. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3958. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3959. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3960. Dest.Data.a := Round(Dest.Range.a * Temp);
  3961. end else
  3962. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3963. end;
  3964. end;
  3965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3966. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3967. type
  3968. PglBitmapPixelData = ^TglBitmapPixelData;
  3969. begin
  3970. with FuncRec do begin
  3971. Dest.Data.r := Source.Data.r;
  3972. Dest.Data.g := Source.Data.g;
  3973. Dest.Data.b := Source.Data.b;
  3974. with PglBitmapPixelData(Args)^ do
  3975. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3976. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3977. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3978. Dest.Data.a := 0
  3979. else
  3980. Dest.Data.a := Dest.Range.a;
  3981. end;
  3982. end;
  3983. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3984. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3985. begin
  3986. with FuncRec do begin
  3987. Dest.Data.r := Source.Data.r;
  3988. Dest.Data.g := Source.Data.g;
  3989. Dest.Data.b := Source.Data.b;
  3990. Dest.Data.a := PCardinal(Args)^;
  3991. end;
  3992. end;
  3993. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3994. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3995. type
  3996. PRGBPix = ^TRGBPix;
  3997. TRGBPix = array [0..2] of byte;
  3998. var
  3999. Temp: Byte;
  4000. begin
  4001. while aWidth > 0 do begin
  4002. Temp := PRGBPix(aData)^[0];
  4003. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  4004. PRGBPix(aData)^[2] := Temp;
  4005. if aHasAlpha then
  4006. Inc(aData, 4)
  4007. else
  4008. Inc(aData, 3);
  4009. dec(aWidth);
  4010. end;
  4011. end;
  4012. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4013. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4014. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4015. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  4016. begin
  4017. result := TFormatDescriptor.Get(Format);
  4018. end;
  4019. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4020. function TglBitmap.GetWidth: Integer;
  4021. begin
  4022. if (ffX in fDimension.Fields) then
  4023. result := fDimension.X
  4024. else
  4025. result := -1;
  4026. end;
  4027. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4028. function TglBitmap.GetHeight: Integer;
  4029. begin
  4030. if (ffY in fDimension.Fields) then
  4031. result := fDimension.Y
  4032. else
  4033. result := -1;
  4034. end;
  4035. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4036. function TglBitmap.GetFileWidth: Integer;
  4037. begin
  4038. result := Max(1, Width);
  4039. end;
  4040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4041. function TglBitmap.GetFileHeight: Integer;
  4042. begin
  4043. result := Max(1, Height);
  4044. end;
  4045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4046. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  4047. begin
  4048. if fCustomData = aValue then
  4049. exit;
  4050. fCustomData := aValue;
  4051. end;
  4052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4053. procedure TglBitmap.SetCustomName(const aValue: String);
  4054. begin
  4055. if fCustomName = aValue then
  4056. exit;
  4057. fCustomName := aValue;
  4058. end;
  4059. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4060. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  4061. begin
  4062. if fCustomNameW = aValue then
  4063. exit;
  4064. fCustomNameW := aValue;
  4065. end;
  4066. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4067. procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
  4068. begin
  4069. if fFreeDataOnDestroy = aValue then
  4070. exit;
  4071. fFreeDataOnDestroy := aValue;
  4072. end;
  4073. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4074. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  4075. begin
  4076. if fDeleteTextureOnFree = aValue then
  4077. exit;
  4078. fDeleteTextureOnFree := aValue;
  4079. end;
  4080. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4081. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  4082. begin
  4083. if fFormat = aValue then
  4084. exit;
  4085. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  4086. raise EglBitmapUnsupportedFormat.Create(Format);
  4087. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  4088. end;
  4089. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4090. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  4091. begin
  4092. if fFreeDataAfterGenTexture = aValue then
  4093. exit;
  4094. fFreeDataAfterGenTexture := aValue;
  4095. end;
  4096. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4097. procedure TglBitmap.SetID(const aValue: Cardinal);
  4098. begin
  4099. if fID = aValue then
  4100. exit;
  4101. fID := aValue;
  4102. end;
  4103. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4104. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  4105. begin
  4106. if fMipMap = aValue then
  4107. exit;
  4108. fMipMap := aValue;
  4109. end;
  4110. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4111. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  4112. begin
  4113. if fTarget = aValue then
  4114. exit;
  4115. fTarget := aValue;
  4116. end;
  4117. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4118. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  4119. var
  4120. MaxAnisotropic: Integer;
  4121. begin
  4122. fAnisotropic := aValue;
  4123. if (ID > 0) then begin
  4124. if GL_EXT_texture_filter_anisotropic then begin
  4125. if fAnisotropic > 0 then begin
  4126. Bind(false);
  4127. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  4128. if aValue > MaxAnisotropic then
  4129. fAnisotropic := MaxAnisotropic;
  4130. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  4131. end;
  4132. end else begin
  4133. fAnisotropic := 0;
  4134. end;
  4135. end;
  4136. end;
  4137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4138. procedure TglBitmap.CreateID;
  4139. begin
  4140. if (ID <> 0) then
  4141. glDeleteTextures(1, @fID);
  4142. glGenTextures(1, @fID);
  4143. Bind(false);
  4144. end;
  4145. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4146. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  4147. begin
  4148. // Set Up Parameters
  4149. SetWrap(fWrapS, fWrapT, fWrapR);
  4150. SetFilter(fFilterMin, fFilterMag);
  4151. SetAnisotropic(fAnisotropic);
  4152. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  4153. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4154. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  4155. // Mip Maps Generation Mode
  4156. aBuildWithGlu := false;
  4157. if (MipMap = mmMipmap) then begin
  4158. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  4159. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  4160. else
  4161. aBuildWithGlu := true;
  4162. end else if (MipMap = mmMipmapGlu) then
  4163. aBuildWithGlu := true;
  4164. end;
  4165. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4166. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  4167. const aWidth: Integer; const aHeight: Integer);
  4168. var
  4169. s: Single;
  4170. begin
  4171. if (Data <> aData) then begin
  4172. if (Assigned(Data)) then
  4173. FreeMem(Data);
  4174. fData := aData;
  4175. end;
  4176. if not Assigned(fData) then begin
  4177. fPixelSize := 0;
  4178. fRowSize := 0;
  4179. end else begin
  4180. FillChar(fDimension, SizeOf(fDimension), 0);
  4181. if aWidth <> -1 then begin
  4182. fDimension.Fields := fDimension.Fields + [ffX];
  4183. fDimension.X := aWidth;
  4184. end;
  4185. if aHeight <> -1 then begin
  4186. fDimension.Fields := fDimension.Fields + [ffY];
  4187. fDimension.Y := aHeight;
  4188. end;
  4189. s := TFormatDescriptor.Get(aFormat).PixelSize;
  4190. fFormat := aFormat;
  4191. fPixelSize := Ceil(s);
  4192. fRowSize := Ceil(s * aWidth);
  4193. end;
  4194. end;
  4195. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4196. function TglBitmap.FlipHorz: Boolean;
  4197. begin
  4198. result := false;
  4199. end;
  4200. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4201. function TglBitmap.FlipVert: Boolean;
  4202. begin
  4203. result := false;
  4204. end;
  4205. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4206. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4207. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4208. procedure TglBitmap.AfterConstruction;
  4209. begin
  4210. inherited AfterConstruction;
  4211. fID := 0;
  4212. fTarget := 0;
  4213. fIsResident := false;
  4214. fMipMap := glBitmapDefaultMipmap;
  4215. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  4216. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  4217. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  4218. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  4219. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  4220. end;
  4221. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4222. procedure TglBitmap.BeforeDestruction;
  4223. var
  4224. NewData: PByte;
  4225. begin
  4226. if fFreeDataOnDestroy then begin
  4227. NewData := nil;
  4228. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  4229. end;
  4230. if (fID > 0) and fDeleteTextureOnFree then
  4231. glDeleteTextures(1, @fID);
  4232. inherited BeforeDestruction;
  4233. end;
  4234. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4235. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  4236. var
  4237. TempPos: Integer;
  4238. begin
  4239. if not Assigned(aResType) then begin
  4240. TempPos := Pos('.', aResource);
  4241. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  4242. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  4243. end;
  4244. end;
  4245. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4246. procedure TglBitmap.LoadFromFile(const aFilename: String);
  4247. var
  4248. fs: TFileStream;
  4249. begin
  4250. if not FileExists(aFilename) then
  4251. raise EglBitmap.Create('file does not exist: ' + aFilename);
  4252. fFilename := aFilename;
  4253. fs := TFileStream.Create(fFilename, fmOpenRead);
  4254. try
  4255. fs.Position := 0;
  4256. LoadFromStream(fs);
  4257. finally
  4258. fs.Free;
  4259. end;
  4260. end;
  4261. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4262. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  4263. begin
  4264. {$IFDEF GLB_SUPPORT_PNG_READ}
  4265. if not LoadPNG(aStream) then
  4266. {$ENDIF}
  4267. {$IFDEF GLB_SUPPORT_JPEG_READ}
  4268. if not LoadJPEG(aStream) then
  4269. {$ENDIF}
  4270. if not LoadDDS(aStream) then
  4271. if not LoadTGA(aStream) then
  4272. if not LoadBMP(aStream) then
  4273. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  4274. end;
  4275. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4276. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  4277. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  4278. var
  4279. tmpData: PByte;
  4280. size: Integer;
  4281. begin
  4282. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4283. GetMem(tmpData, size);
  4284. try
  4285. FillChar(tmpData^, size, #$FF);
  4286. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4287. except
  4288. if Assigned(tmpData) then
  4289. FreeMem(tmpData);
  4290. raise;
  4291. end;
  4292. AddFunc(Self, aFunc, false, aFormat, aArgs);
  4293. end;
  4294. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4295. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  4296. var
  4297. rs: TResourceStream;
  4298. begin
  4299. PrepareResType(aResource, aResType);
  4300. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4301. try
  4302. LoadFromStream(rs);
  4303. finally
  4304. rs.Free;
  4305. end;
  4306. end;
  4307. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4308. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4309. var
  4310. rs: TResourceStream;
  4311. begin
  4312. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4313. try
  4314. LoadFromStream(rs);
  4315. finally
  4316. rs.Free;
  4317. end;
  4318. end;
  4319. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4320. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  4321. var
  4322. fs: TFileStream;
  4323. begin
  4324. fs := TFileStream.Create(aFileName, fmCreate);
  4325. try
  4326. fs.Position := 0;
  4327. SaveToStream(fs, aFileType);
  4328. finally
  4329. fs.Free;
  4330. end;
  4331. end;
  4332. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4333. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  4334. begin
  4335. case aFileType of
  4336. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4337. ftPNG: SavePNG(aStream);
  4338. {$ENDIF}
  4339. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  4340. ftJPEG: SaveJPEG(aStream);
  4341. {$ENDIF}
  4342. ftDDS: SaveDDS(aStream);
  4343. ftTGA: SaveTGA(aStream);
  4344. ftBMP: SaveBMP(aStream);
  4345. end;
  4346. end;
  4347. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4348. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  4349. begin
  4350. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  4351. end;
  4352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4353. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  4354. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  4355. var
  4356. DestData, TmpData, SourceData: pByte;
  4357. TempHeight, TempWidth: Integer;
  4358. SourceFD, DestFD: TFormatDescriptor;
  4359. SourceMD, DestMD: Pointer;
  4360. FuncRec: TglBitmapFunctionRec;
  4361. begin
  4362. Assert(Assigned(Data));
  4363. Assert(Assigned(aSource));
  4364. Assert(Assigned(aSource.Data));
  4365. result := false;
  4366. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  4367. SourceFD := TFormatDescriptor.Get(aSource.Format);
  4368. DestFD := TFormatDescriptor.Get(aFormat);
  4369. if (SourceFD.IsCompressed) then
  4370. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  4371. if (DestFD.IsCompressed) then
  4372. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  4373. // inkompatible Formats so CreateTemp
  4374. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  4375. aCreateTemp := true;
  4376. // Values
  4377. TempHeight := Max(1, aSource.Height);
  4378. TempWidth := Max(1, aSource.Width);
  4379. FuncRec.Sender := Self;
  4380. FuncRec.Args := aArgs;
  4381. TmpData := nil;
  4382. if aCreateTemp then begin
  4383. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  4384. DestData := TmpData;
  4385. end else
  4386. DestData := Data;
  4387. try
  4388. SourceFD.PreparePixel(FuncRec.Source);
  4389. DestFD.PreparePixel (FuncRec.Dest);
  4390. SourceMD := SourceFD.CreateMappingData;
  4391. DestMD := DestFD.CreateMappingData;
  4392. FuncRec.Size := aSource.Dimension;
  4393. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4394. try
  4395. SourceData := aSource.Data;
  4396. FuncRec.Position.Y := 0;
  4397. while FuncRec.Position.Y < TempHeight do begin
  4398. FuncRec.Position.X := 0;
  4399. while FuncRec.Position.X < TempWidth do begin
  4400. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4401. aFunc(FuncRec);
  4402. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  4403. inc(FuncRec.Position.X);
  4404. end;
  4405. inc(FuncRec.Position.Y);
  4406. end;
  4407. // Updating Image or InternalFormat
  4408. if aCreateTemp then
  4409. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  4410. else if (aFormat <> fFormat) then
  4411. Format := aFormat;
  4412. result := true;
  4413. finally
  4414. SourceFD.FreeMappingData(SourceMD);
  4415. DestFD.FreeMappingData(DestMD);
  4416. end;
  4417. except
  4418. if aCreateTemp and Assigned(TmpData) then
  4419. FreeMem(TmpData);
  4420. raise;
  4421. end;
  4422. end;
  4423. end;
  4424. {$IFDEF GLB_SDL}
  4425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4426. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  4427. var
  4428. Row, RowSize: Integer;
  4429. SourceData, TmpData: PByte;
  4430. TempDepth: Integer;
  4431. FormatDesc: TFormatDescriptor;
  4432. function GetRowPointer(Row: Integer): pByte;
  4433. begin
  4434. result := aSurface.pixels;
  4435. Inc(result, Row * RowSize);
  4436. end;
  4437. begin
  4438. result := false;
  4439. FormatDesc := TFormatDescriptor.Get(Format);
  4440. if FormatDesc.IsCompressed then
  4441. raise EglBitmapUnsupportedFormat.Create(Format);
  4442. if Assigned(Data) then begin
  4443. case Trunc(FormatDesc.PixelSize) of
  4444. 1: TempDepth := 8;
  4445. 2: TempDepth := 16;
  4446. 3: TempDepth := 24;
  4447. 4: TempDepth := 32;
  4448. else
  4449. raise EglBitmapUnsupportedFormat.Create(Format);
  4450. end;
  4451. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4452. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4453. SourceData := Data;
  4454. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4455. for Row := 0 to FileHeight-1 do begin
  4456. TmpData := GetRowPointer(Row);
  4457. if Assigned(TmpData) then begin
  4458. Move(SourceData^, TmpData^, RowSize);
  4459. inc(SourceData, RowSize);
  4460. end;
  4461. end;
  4462. result := true;
  4463. end;
  4464. end;
  4465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4466. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4467. var
  4468. pSource, pData, pTempData: PByte;
  4469. Row, RowSize, TempWidth, TempHeight: Integer;
  4470. IntFormat: TglBitmapFormat;
  4471. FormatDesc: TFormatDescriptor;
  4472. function GetRowPointer(Row: Integer): pByte;
  4473. begin
  4474. result := aSurface^.pixels;
  4475. Inc(result, Row * RowSize);
  4476. end;
  4477. begin
  4478. result := false;
  4479. if (Assigned(aSurface)) then begin
  4480. with aSurface^.format^ do begin
  4481. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  4482. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4483. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  4484. break;
  4485. end;
  4486. if (IntFormat = tfEmpty) then
  4487. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  4488. end;
  4489. TempWidth := aSurface^.w;
  4490. TempHeight := aSurface^.h;
  4491. RowSize := FormatDesc.GetSize(TempWidth, 1);
  4492. GetMem(pData, TempHeight * RowSize);
  4493. try
  4494. pTempData := pData;
  4495. for Row := 0 to TempHeight -1 do begin
  4496. pSource := GetRowPointer(Row);
  4497. if (Assigned(pSource)) then begin
  4498. Move(pSource^, pTempData^, RowSize);
  4499. Inc(pTempData, RowSize);
  4500. end;
  4501. end;
  4502. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4503. result := true;
  4504. except
  4505. if Assigned(pData) then
  4506. FreeMem(pData);
  4507. raise;
  4508. end;
  4509. end;
  4510. end;
  4511. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4512. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4513. var
  4514. Row, Col, AlphaInterleave: Integer;
  4515. pSource, pDest: PByte;
  4516. function GetRowPointer(Row: Integer): pByte;
  4517. begin
  4518. result := aSurface.pixels;
  4519. Inc(result, Row * Width);
  4520. end;
  4521. begin
  4522. result := false;
  4523. if Assigned(Data) then begin
  4524. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  4525. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4526. AlphaInterleave := 0;
  4527. case Format of
  4528. tfLuminance8Alpha8:
  4529. AlphaInterleave := 1;
  4530. tfBGRA8, tfRGBA8:
  4531. AlphaInterleave := 3;
  4532. end;
  4533. pSource := Data;
  4534. for Row := 0 to Height -1 do begin
  4535. pDest := GetRowPointer(Row);
  4536. if Assigned(pDest) then begin
  4537. for Col := 0 to Width -1 do begin
  4538. Inc(pSource, AlphaInterleave);
  4539. pDest^ := pSource^;
  4540. Inc(pDest);
  4541. Inc(pSource);
  4542. end;
  4543. end;
  4544. end;
  4545. result := true;
  4546. end;
  4547. end;
  4548. end;
  4549. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4550. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4551. var
  4552. bmp: TglBitmap2D;
  4553. begin
  4554. bmp := TglBitmap2D.Create;
  4555. try
  4556. bmp.AssignFromSurface(aSurface);
  4557. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4558. finally
  4559. bmp.Free;
  4560. end;
  4561. end;
  4562. {$ENDIF}
  4563. {$IFDEF GLB_DELPHI}
  4564. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4565. function CreateGrayPalette: HPALETTE;
  4566. var
  4567. Idx: Integer;
  4568. Pal: PLogPalette;
  4569. begin
  4570. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4571. Pal.palVersion := $300;
  4572. Pal.palNumEntries := 256;
  4573. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4574. Pal.palPalEntry[Idx].peRed := Idx;
  4575. Pal.palPalEntry[Idx].peGreen := Idx;
  4576. Pal.palPalEntry[Idx].peBlue := Idx;
  4577. Pal.palPalEntry[Idx].peFlags := 0;
  4578. end;
  4579. Result := CreatePalette(Pal^);
  4580. FreeMem(Pal);
  4581. end;
  4582. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4583. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4584. var
  4585. Row: Integer;
  4586. pSource, pData: PByte;
  4587. begin
  4588. result := false;
  4589. if Assigned(Data) then begin
  4590. if Assigned(aBitmap) then begin
  4591. aBitmap.Width := Width;
  4592. aBitmap.Height := Height;
  4593. case Format of
  4594. tfAlpha8, tfLuminance8: begin
  4595. aBitmap.PixelFormat := pf8bit;
  4596. aBitmap.Palette := CreateGrayPalette;
  4597. end;
  4598. tfRGB5A1:
  4599. aBitmap.PixelFormat := pf15bit;
  4600. tfR5G6B5:
  4601. aBitmap.PixelFormat := pf16bit;
  4602. tfRGB8, tfBGR8:
  4603. aBitmap.PixelFormat := pf24bit;
  4604. tfRGBA8, tfBGRA8:
  4605. aBitmap.PixelFormat := pf32bit;
  4606. else
  4607. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4608. end;
  4609. pSource := Data;
  4610. for Row := 0 to FileHeight -1 do begin
  4611. pData := aBitmap.Scanline[Row];
  4612. Move(pSource^, pData^, fRowSize);
  4613. Inc(pSource, fRowSize);
  4614. if (Format in [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A)
  4615. SwapRGB(pData, FileWidth, Format = tfRGBA8);
  4616. end;
  4617. result := true;
  4618. end;
  4619. end;
  4620. end;
  4621. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4622. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4623. var
  4624. pSource, pData, pTempData: PByte;
  4625. Row, RowSize, TempWidth, TempHeight: Integer;
  4626. IntFormat: TglBitmapFormat;
  4627. begin
  4628. result := false;
  4629. if (Assigned(aBitmap)) then begin
  4630. case aBitmap.PixelFormat of
  4631. pf8bit:
  4632. IntFormat := tfLuminance8;
  4633. pf15bit:
  4634. IntFormat := tfRGB5A1;
  4635. pf16bit:
  4636. IntFormat := tfR5G6B5;
  4637. pf24bit:
  4638. IntFormat := tfBGR8;
  4639. pf32bit:
  4640. IntFormat := tfBGRA8;
  4641. else
  4642. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4643. end;
  4644. TempWidth := aBitmap.Width;
  4645. TempHeight := aBitmap.Height;
  4646. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4647. GetMem(pData, TempHeight * RowSize);
  4648. try
  4649. pTempData := pData;
  4650. for Row := 0 to TempHeight -1 do begin
  4651. pSource := aBitmap.Scanline[Row];
  4652. if (Assigned(pSource)) then begin
  4653. Move(pSource^, pTempData^, RowSize);
  4654. Inc(pTempData, RowSize);
  4655. end;
  4656. end;
  4657. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4658. result := true;
  4659. except
  4660. if Assigned(pData) then
  4661. FreeMem(pData);
  4662. raise;
  4663. end;
  4664. end;
  4665. end;
  4666. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4667. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4668. var
  4669. Row, Col, AlphaInterleave: Integer;
  4670. pSource, pDest: PByte;
  4671. begin
  4672. result := false;
  4673. if Assigned(Data) then begin
  4674. if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
  4675. if Assigned(aBitmap) then begin
  4676. aBitmap.PixelFormat := pf8bit;
  4677. aBitmap.Palette := CreateGrayPalette;
  4678. aBitmap.Width := Width;
  4679. aBitmap.Height := Height;
  4680. case Format of
  4681. tfLuminance8Alpha8:
  4682. AlphaInterleave := 1;
  4683. tfRGBA8, tfBGRA8:
  4684. AlphaInterleave := 3;
  4685. else
  4686. AlphaInterleave := 0;
  4687. end;
  4688. // Copy Data
  4689. pSource := Data;
  4690. for Row := 0 to Height -1 do begin
  4691. pDest := aBitmap.Scanline[Row];
  4692. if Assigned(pDest) then begin
  4693. for Col := 0 to Width -1 do begin
  4694. Inc(pSource, AlphaInterleave);
  4695. pDest^ := pSource^;
  4696. Inc(pDest);
  4697. Inc(pSource);
  4698. end;
  4699. end;
  4700. end;
  4701. result := true;
  4702. end;
  4703. end;
  4704. end;
  4705. end;
  4706. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4707. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4708. var
  4709. tex: TglBitmap2D;
  4710. begin
  4711. tex := TglBitmap2D.Create;
  4712. try
  4713. tex.AssignFromBitmap(ABitmap);
  4714. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4715. finally
  4716. tex.Free;
  4717. end;
  4718. end;
  4719. {$ENDIF}
  4720. {$IFDEF GLB_LAZARUS}
  4721. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4722. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4723. var
  4724. rid: TRawImageDescription;
  4725. FormatDesc: TFormatDescriptor;
  4726. begin
  4727. result := false;
  4728. if not Assigned(aImage) or (Format = tfEmpty) then
  4729. exit;
  4730. FormatDesc := TFormatDescriptor.Get(Format);
  4731. if FormatDesc.IsCompressed then
  4732. exit;
  4733. FillChar(rid{%H-}, SizeOf(rid), 0);
  4734. if (Format in [
  4735. tfAlpha4, tfAlpha8, tfAlpha16,
  4736. tfLuminance4, tfLuminance8, tfLuminance16,
  4737. tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance16Alpha16]) then
  4738. rid.Format := ricfGray
  4739. else
  4740. rid.Format := ricfRGBA;
  4741. rid.Width := Width;
  4742. rid.Height := Height;
  4743. rid.Depth := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
  4744. rid.BitOrder := riboBitsInOrder;
  4745. rid.ByteOrder := riboLSBFirst;
  4746. rid.LineOrder := riloTopToBottom;
  4747. rid.LineEnd := rileTight;
  4748. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4749. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4750. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4751. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4752. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4753. rid.RedShift := FormatDesc.Shift.r;
  4754. rid.GreenShift := FormatDesc.Shift.g;
  4755. rid.BlueShift := FormatDesc.Shift.b;
  4756. rid.AlphaShift := FormatDesc.Shift.a;
  4757. rid.MaskBitsPerPixel := 0;
  4758. rid.PaletteColorCount := 0;
  4759. aImage.DataDescription := rid;
  4760. aImage.CreateData;
  4761. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4762. result := true;
  4763. end;
  4764. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4765. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4766. var
  4767. f: TglBitmapFormat;
  4768. FormatDesc: TFormatDescriptor;
  4769. ImageData: PByte;
  4770. ImageSize: Integer;
  4771. CanCopy: Boolean;
  4772. procedure CopyConvert;
  4773. var
  4774. bfFormat: TbmpBitfieldFormat;
  4775. pSourceLine, pDestLine: PByte;
  4776. pSourceMD, pDestMD: Pointer;
  4777. x, y: Integer;
  4778. pixel: TglBitmapPixelData;
  4779. begin
  4780. bfFormat := TbmpBitfieldFormat.Create;
  4781. with aImage.DataDescription do begin
  4782. bfFormat.RedMask := ((1 shl RedPrec) - 1) shl RedShift;
  4783. bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
  4784. bfFormat.BlueMask := ((1 shl BluePrec) - 1) shl BlueShift;
  4785. bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
  4786. bfFormat.PixelSize := BitsPerPixel / 8;
  4787. end;
  4788. pSourceMD := bfFormat.CreateMappingData;
  4789. pDestMD := FormatDesc.CreateMappingData;
  4790. try
  4791. for y := 0 to aImage.Height-1 do begin
  4792. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  4793. pDestLine := ImageData + y * Round(FormatDesc.PixelSize * aImage.Width);
  4794. for x := 0 to aImage.Width-1 do begin
  4795. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  4796. FormatDesc.Map(pixel, pDestLine, pDestMD);
  4797. end;
  4798. end;
  4799. finally
  4800. FormatDesc.FreeMappingData(pDestMD);
  4801. bfFormat.FreeMappingData(pSourceMD);
  4802. bfFormat.Free;
  4803. end;
  4804. end;
  4805. begin
  4806. result := false;
  4807. if not Assigned(aImage) then
  4808. exit;
  4809. for f := High(f) downto Low(f) do begin
  4810. FormatDesc := TFormatDescriptor.Get(f);
  4811. with aImage.DataDescription do
  4812. if FormatDesc.MaskMatch(
  4813. (QWord(1 shl RedPrec )-1) shl RedShift,
  4814. (QWord(1 shl GreenPrec)-1) shl GreenShift,
  4815. (QWord(1 shl BluePrec )-1) shl BlueShift,
  4816. (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
  4817. break;
  4818. end;
  4819. if (f = tfEmpty) then
  4820. exit;
  4821. CanCopy :=
  4822. (Round(FormatDesc.PixelSize * 8) = aImage.DataDescription.Depth) and
  4823. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  4824. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4825. ImageData := GetMem(ImageSize);
  4826. try
  4827. if CanCopy then
  4828. Move(aImage.PixelData^, ImageData^, ImageSize)
  4829. else
  4830. CopyConvert;
  4831. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4832. except
  4833. if Assigned(ImageData) then
  4834. FreeMem(ImageData);
  4835. raise;
  4836. end;
  4837. result := true;
  4838. end;
  4839. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4840. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4841. var
  4842. rid: TRawImageDescription;
  4843. FormatDesc: TFormatDescriptor;
  4844. Pixel: TglBitmapPixelData;
  4845. x, y: Integer;
  4846. srcMD: Pointer;
  4847. src, dst: PByte;
  4848. begin
  4849. result := false;
  4850. if not Assigned(aImage) or (Format = tfEmpty) then
  4851. exit;
  4852. FormatDesc := TFormatDescriptor.Get(Format);
  4853. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4854. exit;
  4855. FillChar(rid{%H-}, SizeOf(rid), 0);
  4856. rid.Format := ricfGray;
  4857. rid.Width := Width;
  4858. rid.Height := Height;
  4859. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4860. rid.BitOrder := riboBitsInOrder;
  4861. rid.ByteOrder := riboLSBFirst;
  4862. rid.LineOrder := riloTopToBottom;
  4863. rid.LineEnd := rileTight;
  4864. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4865. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4866. rid.GreenPrec := 0;
  4867. rid.BluePrec := 0;
  4868. rid.AlphaPrec := 0;
  4869. rid.RedShift := 0;
  4870. rid.GreenShift := 0;
  4871. rid.BlueShift := 0;
  4872. rid.AlphaShift := 0;
  4873. rid.MaskBitsPerPixel := 0;
  4874. rid.PaletteColorCount := 0;
  4875. aImage.DataDescription := rid;
  4876. aImage.CreateData;
  4877. srcMD := FormatDesc.CreateMappingData;
  4878. try
  4879. FormatDesc.PreparePixel(Pixel);
  4880. src := Data;
  4881. dst := aImage.PixelData;
  4882. for y := 0 to Height-1 do
  4883. for x := 0 to Width-1 do begin
  4884. FormatDesc.Unmap(src, Pixel, srcMD);
  4885. case rid.BitsPerPixel of
  4886. 8: begin
  4887. dst^ := Pixel.Data.a;
  4888. inc(dst);
  4889. end;
  4890. 16: begin
  4891. PWord(dst)^ := Pixel.Data.a;
  4892. inc(dst, 2);
  4893. end;
  4894. 24: begin
  4895. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4896. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4897. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4898. inc(dst, 3);
  4899. end;
  4900. 32: begin
  4901. PCardinal(dst)^ := Pixel.Data.a;
  4902. inc(dst, 4);
  4903. end;
  4904. else
  4905. raise EglBitmapUnsupportedFormat.Create(Format);
  4906. end;
  4907. end;
  4908. finally
  4909. FormatDesc.FreeMappingData(srcMD);
  4910. end;
  4911. result := true;
  4912. end;
  4913. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4914. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4915. var
  4916. tex: TglBitmap2D;
  4917. begin
  4918. tex := TglBitmap2D.Create;
  4919. try
  4920. tex.AssignFromLazIntfImage(aImage);
  4921. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4922. finally
  4923. tex.Free;
  4924. end;
  4925. end;
  4926. {$ENDIF}
  4927. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4928. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4929. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4930. var
  4931. rs: TResourceStream;
  4932. begin
  4933. PrepareResType(aResource, aResType);
  4934. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4935. try
  4936. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4937. finally
  4938. rs.Free;
  4939. end;
  4940. end;
  4941. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4942. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4943. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4944. var
  4945. rs: TResourceStream;
  4946. begin
  4947. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4948. try
  4949. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4950. finally
  4951. rs.Free;
  4952. end;
  4953. end;
  4954. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4955. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4956. begin
  4957. if TFormatDescriptor.Get(Format).IsCompressed then
  4958. raise EglBitmapUnsupportedFormat.Create(Format);
  4959. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4960. end;
  4961. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4962. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4963. var
  4964. FS: TFileStream;
  4965. begin
  4966. FS := TFileStream.Create(aFileName, fmOpenRead);
  4967. try
  4968. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4969. finally
  4970. FS.Free;
  4971. end;
  4972. end;
  4973. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4974. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4975. var
  4976. tex: TglBitmap2D;
  4977. begin
  4978. tex := TglBitmap2D.Create(aStream);
  4979. try
  4980. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4981. finally
  4982. tex.Free;
  4983. end;
  4984. end;
  4985. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4986. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4987. var
  4988. DestData, DestData2, SourceData: pByte;
  4989. TempHeight, TempWidth: Integer;
  4990. SourceFD, DestFD: TFormatDescriptor;
  4991. SourceMD, DestMD, DestMD2: Pointer;
  4992. FuncRec: TglBitmapFunctionRec;
  4993. begin
  4994. result := false;
  4995. Assert(Assigned(Data));
  4996. Assert(Assigned(aBitmap));
  4997. Assert(Assigned(aBitmap.Data));
  4998. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4999. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  5000. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  5001. DestFD := TFormatDescriptor.Get(Format);
  5002. if not Assigned(aFunc) then begin
  5003. aFunc := glBitmapAlphaFunc;
  5004. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  5005. end else
  5006. FuncRec.Args := aArgs;
  5007. // Values
  5008. TempHeight := aBitmap.FileHeight;
  5009. TempWidth := aBitmap.FileWidth;
  5010. FuncRec.Sender := Self;
  5011. FuncRec.Size := Dimension;
  5012. FuncRec.Position.Fields := FuncRec.Size.Fields;
  5013. DestData := Data;
  5014. DestData2 := Data;
  5015. SourceData := aBitmap.Data;
  5016. // Mapping
  5017. SourceFD.PreparePixel(FuncRec.Source);
  5018. DestFD.PreparePixel (FuncRec.Dest);
  5019. SourceMD := SourceFD.CreateMappingData;
  5020. DestMD := DestFD.CreateMappingData;
  5021. DestMD2 := DestFD.CreateMappingData;
  5022. try
  5023. FuncRec.Position.Y := 0;
  5024. while FuncRec.Position.Y < TempHeight do begin
  5025. FuncRec.Position.X := 0;
  5026. while FuncRec.Position.X < TempWidth do begin
  5027. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  5028. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  5029. aFunc(FuncRec);
  5030. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  5031. inc(FuncRec.Position.X);
  5032. end;
  5033. inc(FuncRec.Position.Y);
  5034. end;
  5035. finally
  5036. SourceFD.FreeMappingData(SourceMD);
  5037. DestFD.FreeMappingData(DestMD);
  5038. DestFD.FreeMappingData(DestMD2);
  5039. end;
  5040. end;
  5041. end;
  5042. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5043. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  5044. begin
  5045. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  5046. end;
  5047. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5048. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  5049. var
  5050. PixelData: TglBitmapPixelData;
  5051. begin
  5052. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5053. result := AddAlphaFromColorKeyFloat(
  5054. aRed / PixelData.Range.r,
  5055. aGreen / PixelData.Range.g,
  5056. aBlue / PixelData.Range.b,
  5057. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  5058. end;
  5059. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5060. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  5061. var
  5062. values: array[0..2] of Single;
  5063. tmp: Cardinal;
  5064. i: Integer;
  5065. PixelData: TglBitmapPixelData;
  5066. begin
  5067. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5068. with PixelData do begin
  5069. values[0] := aRed;
  5070. values[1] := aGreen;
  5071. values[2] := aBlue;
  5072. for i := 0 to 2 do begin
  5073. tmp := Trunc(Range.arr[i] * aDeviation);
  5074. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  5075. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  5076. end;
  5077. Data.a := 0;
  5078. Range.a := 0;
  5079. end;
  5080. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  5081. end;
  5082. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5083. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  5084. begin
  5085. result := AddAlphaFromValueFloat(aAlpha / $FF);
  5086. end;
  5087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5088. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  5089. var
  5090. PixelData: TglBitmapPixelData;
  5091. begin
  5092. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5093. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  5094. end;
  5095. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5096. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  5097. var
  5098. PixelData: TglBitmapPixelData;
  5099. begin
  5100. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5101. with PixelData do
  5102. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  5103. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  5104. end;
  5105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5106. function TglBitmap.RemoveAlpha: Boolean;
  5107. var
  5108. FormatDesc: TFormatDescriptor;
  5109. begin
  5110. result := false;
  5111. FormatDesc := TFormatDescriptor.Get(Format);
  5112. if Assigned(Data) then begin
  5113. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  5114. raise EglBitmapUnsupportedFormat.Create(Format);
  5115. result := ConvertTo(FormatDesc.WithoutAlpha);
  5116. end;
  5117. end;
  5118. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5119. function TglBitmap.Clone: TglBitmap;
  5120. var
  5121. Temp: TglBitmap;
  5122. TempPtr: PByte;
  5123. Size: Integer;
  5124. begin
  5125. result := nil;
  5126. Temp := (ClassType.Create as TglBitmap);
  5127. try
  5128. // copy texture data if assigned
  5129. if Assigned(Data) then begin
  5130. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  5131. GetMem(TempPtr, Size);
  5132. try
  5133. Move(Data^, TempPtr^, Size);
  5134. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  5135. except
  5136. if Assigned(TempPtr) then
  5137. FreeMem(TempPtr);
  5138. raise;
  5139. end;
  5140. end else begin
  5141. TempPtr := nil;
  5142. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  5143. end;
  5144. // copy properties
  5145. Temp.fID := ID;
  5146. Temp.fTarget := Target;
  5147. Temp.fFormat := Format;
  5148. Temp.fMipMap := MipMap;
  5149. Temp.fAnisotropic := Anisotropic;
  5150. Temp.fBorderColor := fBorderColor;
  5151. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  5152. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  5153. Temp.fFilterMin := fFilterMin;
  5154. Temp.fFilterMag := fFilterMag;
  5155. Temp.fWrapS := fWrapS;
  5156. Temp.fWrapT := fWrapT;
  5157. Temp.fWrapR := fWrapR;
  5158. Temp.fFilename := fFilename;
  5159. Temp.fCustomName := fCustomName;
  5160. Temp.fCustomNameW := fCustomNameW;
  5161. Temp.fCustomData := fCustomData;
  5162. result := Temp;
  5163. except
  5164. FreeAndNil(Temp);
  5165. raise;
  5166. end;
  5167. end;
  5168. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5169. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  5170. var
  5171. SourceFD, DestFD: TFormatDescriptor;
  5172. SourcePD, DestPD: TglBitmapPixelData;
  5173. ShiftData: TShiftData;
  5174. function DataIsIdentical: Boolean;
  5175. begin
  5176. result :=
  5177. (SourceFD.RedMask = DestFD.RedMask) and
  5178. (SourceFD.GreenMask = DestFD.GreenMask) and
  5179. (SourceFD.BlueMask = DestFD.BlueMask) and
  5180. (SourceFD.AlphaMask = DestFD.AlphaMask);
  5181. end;
  5182. function CanCopyDirect: Boolean;
  5183. begin
  5184. result :=
  5185. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5186. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5187. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5188. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5189. end;
  5190. function CanShift: Boolean;
  5191. begin
  5192. result :=
  5193. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5194. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5195. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5196. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5197. end;
  5198. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  5199. begin
  5200. result := 0;
  5201. while (aSource > aDest) and (aSource > 0) do begin
  5202. inc(result);
  5203. aSource := aSource shr 1;
  5204. end;
  5205. end;
  5206. begin
  5207. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  5208. SourceFD := TFormatDescriptor.Get(Format);
  5209. DestFD := TFormatDescriptor.Get(aFormat);
  5210. if DataIsIdentical then begin
  5211. result := true;
  5212. Format := aFormat;
  5213. exit;
  5214. end;
  5215. SourceFD.PreparePixel(SourcePD);
  5216. DestFD.PreparePixel (DestPD);
  5217. if CanCopyDirect then
  5218. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  5219. else if CanShift then begin
  5220. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  5221. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  5222. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  5223. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  5224. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  5225. end else
  5226. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  5227. end else
  5228. result := true;
  5229. end;
  5230. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5231. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  5232. begin
  5233. if aUseRGB or aUseAlpha then
  5234. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  5235. ((Byte(aUseAlpha) and 1) shl 1) or
  5236. (Byte(aUseRGB) and 1) ));
  5237. end;
  5238. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5239. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  5240. begin
  5241. fBorderColor[0] := aRed;
  5242. fBorderColor[1] := aGreen;
  5243. fBorderColor[2] := aBlue;
  5244. fBorderColor[3] := aAlpha;
  5245. if (ID > 0) then begin
  5246. Bind(false);
  5247. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  5248. end;
  5249. end;
  5250. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5251. procedure TglBitmap.FreeData;
  5252. var
  5253. TempPtr: PByte;
  5254. begin
  5255. TempPtr := nil;
  5256. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  5257. end;
  5258. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5259. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  5260. const aAlpha: Byte);
  5261. begin
  5262. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  5263. end;
  5264. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5265. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  5266. var
  5267. PixelData: TglBitmapPixelData;
  5268. begin
  5269. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  5270. FillWithColorFloat(
  5271. aRed / PixelData.Range.r,
  5272. aGreen / PixelData.Range.g,
  5273. aBlue / PixelData.Range.b,
  5274. aAlpha / PixelData.Range.a);
  5275. end;
  5276. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5277. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  5278. var
  5279. PixelData: TglBitmapPixelData;
  5280. begin
  5281. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  5282. with PixelData do begin
  5283. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  5284. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  5285. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  5286. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  5287. end;
  5288. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  5289. end;
  5290. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5291. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  5292. begin
  5293. //check MIN filter
  5294. case aMin of
  5295. GL_NEAREST:
  5296. fFilterMin := GL_NEAREST;
  5297. GL_LINEAR:
  5298. fFilterMin := GL_LINEAR;
  5299. GL_NEAREST_MIPMAP_NEAREST:
  5300. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  5301. GL_LINEAR_MIPMAP_NEAREST:
  5302. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  5303. GL_NEAREST_MIPMAP_LINEAR:
  5304. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  5305. GL_LINEAR_MIPMAP_LINEAR:
  5306. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  5307. else
  5308. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  5309. end;
  5310. //check MAG filter
  5311. case aMag of
  5312. GL_NEAREST:
  5313. fFilterMag := GL_NEAREST;
  5314. GL_LINEAR:
  5315. fFilterMag := GL_LINEAR;
  5316. else
  5317. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  5318. end;
  5319. //apply filter
  5320. if (ID > 0) then begin
  5321. Bind(false);
  5322. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  5323. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  5324. case fFilterMin of
  5325. GL_NEAREST, GL_LINEAR:
  5326. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5327. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  5328. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  5329. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  5330. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  5331. end;
  5332. end else
  5333. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  5334. end;
  5335. end;
  5336. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5337. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  5338. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  5339. begin
  5340. case aValue of
  5341. GL_CLAMP:
  5342. aTarget := GL_CLAMP;
  5343. GL_REPEAT:
  5344. aTarget := GL_REPEAT;
  5345. GL_CLAMP_TO_EDGE: begin
  5346. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  5347. aTarget := GL_CLAMP_TO_EDGE
  5348. else
  5349. aTarget := GL_CLAMP;
  5350. end;
  5351. GL_CLAMP_TO_BORDER: begin
  5352. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  5353. aTarget := GL_CLAMP_TO_BORDER
  5354. else
  5355. aTarget := GL_CLAMP;
  5356. end;
  5357. GL_MIRRORED_REPEAT: begin
  5358. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  5359. aTarget := GL_MIRRORED_REPEAT
  5360. else
  5361. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  5362. end;
  5363. else
  5364. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  5365. end;
  5366. end;
  5367. begin
  5368. CheckAndSetWrap(S, fWrapS);
  5369. CheckAndSetWrap(T, fWrapT);
  5370. CheckAndSetWrap(R, fWrapR);
  5371. if (ID > 0) then begin
  5372. Bind(false);
  5373. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  5374. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  5375. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  5376. end;
  5377. end;
  5378. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5379. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  5380. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  5381. begin
  5382. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  5383. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  5384. fSwizzle[aIndex] := aValue
  5385. else
  5386. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  5387. end;
  5388. begin
  5389. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  5390. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  5391. CheckAndSetValue(r, 0);
  5392. CheckAndSetValue(g, 1);
  5393. CheckAndSetValue(b, 2);
  5394. CheckAndSetValue(a, 3);
  5395. if (ID > 0) then begin
  5396. Bind(false);
  5397. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  5398. end;
  5399. end;
  5400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5401. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  5402. begin
  5403. if aEnableTextureUnit then
  5404. glEnable(Target);
  5405. if (ID > 0) then
  5406. glBindTexture(Target, ID);
  5407. end;
  5408. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5409. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  5410. begin
  5411. if aDisableTextureUnit then
  5412. glDisable(Target);
  5413. glBindTexture(Target, 0);
  5414. end;
  5415. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5416. constructor TglBitmap.Create;
  5417. begin
  5418. if (ClassType = TglBitmap) then
  5419. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  5420. {$IFDEF GLB_NATIVE_OGL}
  5421. glbReadOpenGLExtensions;
  5422. {$ENDIF}
  5423. inherited Create;
  5424. fFormat := glBitmapGetDefaultFormat;
  5425. fFreeDataOnDestroy := true;
  5426. end;
  5427. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5428. constructor TglBitmap.Create(const aFileName: String);
  5429. begin
  5430. Create;
  5431. LoadFromFile(aFileName);
  5432. end;
  5433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5434. constructor TglBitmap.Create(const aStream: TStream);
  5435. begin
  5436. Create;
  5437. LoadFromStream(aStream);
  5438. end;
  5439. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5440. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
  5441. var
  5442. ImageSize: Integer;
  5443. begin
  5444. Create;
  5445. if not Assigned(aData) then begin
  5446. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5447. GetMem(aData, ImageSize);
  5448. try
  5449. FillChar(aData^, ImageSize, #$FF);
  5450. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5451. except
  5452. if Assigned(aData) then
  5453. FreeMem(aData);
  5454. raise;
  5455. end;
  5456. end else begin
  5457. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5458. fFreeDataOnDestroy := false;
  5459. end;
  5460. end;
  5461. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5462. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5463. begin
  5464. Create;
  5465. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  5466. end;
  5467. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5468. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  5469. begin
  5470. Create;
  5471. LoadFromResource(aInstance, aResource, aResType);
  5472. end;
  5473. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5474. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5475. begin
  5476. Create;
  5477. LoadFromResourceID(aInstance, aResourceID, aResType);
  5478. end;
  5479. {$IFDEF GLB_SUPPORT_PNG_READ}
  5480. {$IF DEFINED(GLB_LAZ_PNG)}
  5481. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5482. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5483. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5484. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5485. const
  5486. MAGIC_LEN = 8;
  5487. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  5488. var
  5489. reader: TLazReaderPNG;
  5490. intf: TLazIntfImage;
  5491. StreamPos: Int64;
  5492. magic: String[MAGIC_LEN];
  5493. begin
  5494. result := true;
  5495. StreamPos := aStream.Position;
  5496. SetLength(magic, MAGIC_LEN);
  5497. aStream.Read(magic[1], MAGIC_LEN);
  5498. aStream.Position := StreamPos;
  5499. if (magic <> PNG_MAGIC) then begin
  5500. result := false;
  5501. exit;
  5502. end;
  5503. intf := TLazIntfImage.Create(0, 0);
  5504. reader := TLazReaderPNG.Create;
  5505. try try
  5506. reader.UpdateDescription := true;
  5507. reader.ImageRead(aStream, intf);
  5508. AssignFromLazIntfImage(intf);
  5509. except
  5510. result := false;
  5511. aStream.Position := StreamPos;
  5512. exit;
  5513. end;
  5514. finally
  5515. reader.Free;
  5516. intf.Free;
  5517. end;
  5518. end;
  5519. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5520. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5521. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5522. var
  5523. Surface: PSDL_Surface;
  5524. RWops: PSDL_RWops;
  5525. begin
  5526. result := false;
  5527. RWops := glBitmapCreateRWops(aStream);
  5528. try
  5529. if IMG_isPNG(RWops) > 0 then begin
  5530. Surface := IMG_LoadPNG_RW(RWops);
  5531. try
  5532. AssignFromSurface(Surface);
  5533. result := true;
  5534. finally
  5535. SDL_FreeSurface(Surface);
  5536. end;
  5537. end;
  5538. finally
  5539. SDL_FreeRW(RWops);
  5540. end;
  5541. end;
  5542. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5543. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5544. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5545. begin
  5546. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5547. end;
  5548. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5549. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5550. var
  5551. StreamPos: Int64;
  5552. signature: array [0..7] of byte;
  5553. png: png_structp;
  5554. png_info: png_infop;
  5555. TempHeight, TempWidth: Integer;
  5556. Format: TglBitmapFormat;
  5557. png_data: pByte;
  5558. png_rows: array of pByte;
  5559. Row, LineSize: Integer;
  5560. begin
  5561. result := false;
  5562. if not init_libPNG then
  5563. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5564. try
  5565. // signature
  5566. StreamPos := aStream.Position;
  5567. aStream.Read(signature{%H-}, 8);
  5568. aStream.Position := StreamPos;
  5569. if png_check_sig(@signature, 8) <> 0 then begin
  5570. // png read struct
  5571. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5572. if png = nil then
  5573. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5574. // png info
  5575. png_info := png_create_info_struct(png);
  5576. if png_info = nil then begin
  5577. png_destroy_read_struct(@png, nil, nil);
  5578. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5579. end;
  5580. // set read callback
  5581. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5582. // read informations
  5583. png_read_info(png, png_info);
  5584. // size
  5585. TempHeight := png_get_image_height(png, png_info);
  5586. TempWidth := png_get_image_width(png, png_info);
  5587. // format
  5588. case png_get_color_type(png, png_info) of
  5589. PNG_COLOR_TYPE_GRAY:
  5590. Format := tfLuminance8;
  5591. PNG_COLOR_TYPE_GRAY_ALPHA:
  5592. Format := tfLuminance8Alpha8;
  5593. PNG_COLOR_TYPE_RGB:
  5594. Format := tfRGB8;
  5595. PNG_COLOR_TYPE_RGB_ALPHA:
  5596. Format := tfRGBA8;
  5597. else
  5598. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5599. end;
  5600. // cut upper 8 bit from 16 bit formats
  5601. if png_get_bit_depth(png, png_info) > 8 then
  5602. png_set_strip_16(png);
  5603. // expand bitdepth smaller than 8
  5604. if png_get_bit_depth(png, png_info) < 8 then
  5605. png_set_expand(png);
  5606. // allocating mem for scanlines
  5607. LineSize := png_get_rowbytes(png, png_info);
  5608. GetMem(png_data, TempHeight * LineSize);
  5609. try
  5610. SetLength(png_rows, TempHeight);
  5611. for Row := Low(png_rows) to High(png_rows) do begin
  5612. png_rows[Row] := png_data;
  5613. Inc(png_rows[Row], Row * LineSize);
  5614. end;
  5615. // read complete image into scanlines
  5616. png_read_image(png, @png_rows[0]);
  5617. // read end
  5618. png_read_end(png, png_info);
  5619. // destroy read struct
  5620. png_destroy_read_struct(@png, @png_info, nil);
  5621. SetLength(png_rows, 0);
  5622. // set new data
  5623. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5624. result := true;
  5625. except
  5626. if Assigned(png_data) then
  5627. FreeMem(png_data);
  5628. raise;
  5629. end;
  5630. end;
  5631. finally
  5632. quit_libPNG;
  5633. end;
  5634. end;
  5635. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5636. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5637. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5638. var
  5639. StreamPos: Int64;
  5640. Png: TPNGObject;
  5641. Header: String[8];
  5642. Row, Col, PixSize, LineSize: Integer;
  5643. NewImage, pSource, pDest, pAlpha: pByte;
  5644. PngFormat: TglBitmapFormat;
  5645. FormatDesc: TFormatDescriptor;
  5646. const
  5647. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5648. begin
  5649. result := false;
  5650. StreamPos := aStream.Position;
  5651. aStream.Read(Header[0], SizeOf(Header));
  5652. aStream.Position := StreamPos;
  5653. {Test if the header matches}
  5654. if Header = PngHeader then begin
  5655. Png := TPNGObject.Create;
  5656. try
  5657. Png.LoadFromStream(aStream);
  5658. case Png.Header.ColorType of
  5659. COLOR_GRAYSCALE:
  5660. PngFormat := tfLuminance8;
  5661. COLOR_GRAYSCALEALPHA:
  5662. PngFormat := tfLuminance8Alpha8;
  5663. COLOR_RGB:
  5664. PngFormat := tfBGR8;
  5665. COLOR_RGBALPHA:
  5666. PngFormat := tfBGRA8;
  5667. else
  5668. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5669. end;
  5670. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5671. PixSize := Round(FormatDesc.PixelSize);
  5672. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5673. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5674. try
  5675. pDest := NewImage;
  5676. case Png.Header.ColorType of
  5677. COLOR_RGB, COLOR_GRAYSCALE:
  5678. begin
  5679. for Row := 0 to Png.Height -1 do begin
  5680. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5681. Inc(pDest, LineSize);
  5682. end;
  5683. end;
  5684. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5685. begin
  5686. PixSize := PixSize -1;
  5687. for Row := 0 to Png.Height -1 do begin
  5688. pSource := Png.Scanline[Row];
  5689. pAlpha := pByte(Png.AlphaScanline[Row]);
  5690. for Col := 0 to Png.Width -1 do begin
  5691. Move (pSource^, pDest^, PixSize);
  5692. Inc(pSource, PixSize);
  5693. Inc(pDest, PixSize);
  5694. pDest^ := pAlpha^;
  5695. inc(pAlpha);
  5696. Inc(pDest);
  5697. end;
  5698. end;
  5699. end;
  5700. else
  5701. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5702. end;
  5703. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5704. result := true;
  5705. except
  5706. if Assigned(NewImage) then
  5707. FreeMem(NewImage);
  5708. raise;
  5709. end;
  5710. finally
  5711. Png.Free;
  5712. end;
  5713. end;
  5714. end;
  5715. {$IFEND}
  5716. {$ENDIF}
  5717. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5718. {$IFDEF GLB_LIB_PNG}
  5719. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5720. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5721. begin
  5722. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5723. end;
  5724. {$ENDIF}
  5725. {$IF DEFINED(GLB_LAZ_PNG)}
  5726. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5727. procedure TglBitmap.SavePNG(const aStream: TStream);
  5728. var
  5729. png: TPortableNetworkGraphic;
  5730. intf: TLazIntfImage;
  5731. raw: TRawImage;
  5732. begin
  5733. png := TPortableNetworkGraphic.Create;
  5734. intf := TLazIntfImage.Create(0, 0);
  5735. try
  5736. if not AssignToLazIntfImage(intf) then
  5737. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5738. intf.GetRawImage(raw);
  5739. png.LoadFromRawImage(raw, false);
  5740. png.SaveToStream(aStream);
  5741. finally
  5742. png.Free;
  5743. intf.Free;
  5744. end;
  5745. end;
  5746. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5747. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5748. procedure TglBitmap.SavePNG(const aStream: TStream);
  5749. var
  5750. png: png_structp;
  5751. png_info: png_infop;
  5752. png_rows: array of pByte;
  5753. LineSize: Integer;
  5754. ColorType: Integer;
  5755. Row: Integer;
  5756. FormatDesc: TFormatDescriptor;
  5757. begin
  5758. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5759. raise EglBitmapUnsupportedFormat.Create(Format);
  5760. if not init_libPNG then
  5761. raise Exception.Create('unable to initialize libPNG.');
  5762. try
  5763. case Format of
  5764. tfAlpha8, tfLuminance8:
  5765. ColorType := PNG_COLOR_TYPE_GRAY;
  5766. tfLuminance8Alpha8:
  5767. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5768. tfBGR8, tfRGB8:
  5769. ColorType := PNG_COLOR_TYPE_RGB;
  5770. tfBGRA8, tfRGBA8:
  5771. ColorType := PNG_COLOR_TYPE_RGBA;
  5772. else
  5773. raise EglBitmapUnsupportedFormat.Create(Format);
  5774. end;
  5775. FormatDesc := TFormatDescriptor.Get(Format);
  5776. LineSize := FormatDesc.GetSize(Width, 1);
  5777. // creating array for scanline
  5778. SetLength(png_rows, Height);
  5779. try
  5780. for Row := 0 to Height - 1 do begin
  5781. png_rows[Row] := Data;
  5782. Inc(png_rows[Row], Row * LineSize)
  5783. end;
  5784. // write struct
  5785. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5786. if png = nil then
  5787. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5788. // create png info
  5789. png_info := png_create_info_struct(png);
  5790. if png_info = nil then begin
  5791. png_destroy_write_struct(@png, nil);
  5792. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5793. end;
  5794. // set read callback
  5795. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5796. // set compression
  5797. png_set_compression_level(png, 6);
  5798. if Format in [tfBGR8, tfBGRA8] then
  5799. png_set_bgr(png);
  5800. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5801. png_write_info(png, png_info);
  5802. png_write_image(png, @png_rows[0]);
  5803. png_write_end(png, png_info);
  5804. png_destroy_write_struct(@png, @png_info);
  5805. finally
  5806. SetLength(png_rows, 0);
  5807. end;
  5808. finally
  5809. quit_libPNG;
  5810. end;
  5811. end;
  5812. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5813. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5814. procedure TglBitmap.SavePNG(const aStream: TStream);
  5815. var
  5816. Png: TPNGObject;
  5817. pSource, pDest: pByte;
  5818. X, Y, PixSize: Integer;
  5819. ColorType: Cardinal;
  5820. Alpha: Boolean;
  5821. pTemp: pByte;
  5822. Temp: Byte;
  5823. begin
  5824. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5825. raise EglBitmapUnsupportedFormat.Create(Format);
  5826. case Format of
  5827. tfAlpha8, tfLuminance8: begin
  5828. ColorType := COLOR_GRAYSCALE;
  5829. PixSize := 1;
  5830. Alpha := false;
  5831. end;
  5832. tfLuminance8Alpha8: begin
  5833. ColorType := COLOR_GRAYSCALEALPHA;
  5834. PixSize := 1;
  5835. Alpha := true;
  5836. end;
  5837. tfBGR8, tfRGB8: begin
  5838. ColorType := COLOR_RGB;
  5839. PixSize := 3;
  5840. Alpha := false;
  5841. end;
  5842. tfBGRA8, tfRGBA8: begin
  5843. ColorType := COLOR_RGBALPHA;
  5844. PixSize := 3;
  5845. Alpha := true
  5846. end;
  5847. else
  5848. raise EglBitmapUnsupportedFormat.Create(Format);
  5849. end;
  5850. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5851. try
  5852. // Copy ImageData
  5853. pSource := Data;
  5854. for Y := 0 to Height -1 do begin
  5855. pDest := png.ScanLine[Y];
  5856. for X := 0 to Width -1 do begin
  5857. Move(pSource^, pDest^, PixSize);
  5858. Inc(pDest, PixSize);
  5859. Inc(pSource, PixSize);
  5860. if Alpha then begin
  5861. png.AlphaScanline[Y]^[X] := pSource^;
  5862. Inc(pSource);
  5863. end;
  5864. end;
  5865. // convert RGB line to BGR
  5866. if Format in [tfRGB8, tfRGBA8] then begin
  5867. pTemp := png.ScanLine[Y];
  5868. for X := 0 to Width -1 do begin
  5869. Temp := pByteArray(pTemp)^[0];
  5870. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5871. pByteArray(pTemp)^[2] := Temp;
  5872. Inc(pTemp, 3);
  5873. end;
  5874. end;
  5875. end;
  5876. // Save to Stream
  5877. Png.CompressionLevel := 6;
  5878. Png.SaveToStream(aStream);
  5879. finally
  5880. FreeAndNil(Png);
  5881. end;
  5882. end;
  5883. {$IFEND}
  5884. {$ENDIF}
  5885. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5886. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5887. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5888. {$IFDEF GLB_LIB_JPEG}
  5889. type
  5890. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5891. glBitmap_libJPEG_source_mgr = record
  5892. pub: jpeg_source_mgr;
  5893. SrcStream: TStream;
  5894. SrcBuffer: array [1..4096] of byte;
  5895. end;
  5896. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5897. glBitmap_libJPEG_dest_mgr = record
  5898. pub: jpeg_destination_mgr;
  5899. DestStream: TStream;
  5900. DestBuffer: array [1..4096] of byte;
  5901. end;
  5902. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5903. begin
  5904. //DUMMY
  5905. end;
  5906. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5907. begin
  5908. //DUMMY
  5909. end;
  5910. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5911. begin
  5912. //DUMMY
  5913. end;
  5914. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5915. begin
  5916. //DUMMY
  5917. end;
  5918. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5919. begin
  5920. //DUMMY
  5921. end;
  5922. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5923. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5924. var
  5925. src: glBitmap_libJPEG_source_mgr_ptr;
  5926. bytes: integer;
  5927. begin
  5928. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5929. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5930. if (bytes <= 0) then begin
  5931. src^.SrcBuffer[1] := $FF;
  5932. src^.SrcBuffer[2] := JPEG_EOI;
  5933. bytes := 2;
  5934. end;
  5935. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5936. src^.pub.bytes_in_buffer := bytes;
  5937. result := true;
  5938. end;
  5939. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5940. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5941. var
  5942. src: glBitmap_libJPEG_source_mgr_ptr;
  5943. begin
  5944. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5945. if num_bytes > 0 then begin
  5946. // wanted byte isn't in buffer so set stream position and read buffer
  5947. if num_bytes > src^.pub.bytes_in_buffer then begin
  5948. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5949. src^.pub.fill_input_buffer(cinfo);
  5950. end else begin
  5951. // wanted byte is in buffer so only skip
  5952. inc(src^.pub.next_input_byte, num_bytes);
  5953. dec(src^.pub.bytes_in_buffer, num_bytes);
  5954. end;
  5955. end;
  5956. end;
  5957. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5958. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5959. var
  5960. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5961. begin
  5962. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5963. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5964. // write complete buffer
  5965. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5966. // reset buffer
  5967. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5968. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5969. end;
  5970. result := true;
  5971. end;
  5972. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5973. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5974. var
  5975. Idx: Integer;
  5976. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5977. begin
  5978. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5979. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5980. // check for endblock
  5981. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5982. // write endblock
  5983. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5984. // leave
  5985. break;
  5986. end else
  5987. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5988. end;
  5989. end;
  5990. {$ENDIF}
  5991. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5992. {$IF DEFINED(GLB_LAZ_JPEG)}
  5993. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5994. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5995. const
  5996. MAGIC_LEN = 2;
  5997. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  5998. var
  5999. intf: TLazIntfImage;
  6000. reader: TFPReaderJPEG;
  6001. StreamPos: Int64;
  6002. magic: String[MAGIC_LEN];
  6003. begin
  6004. result := true;
  6005. StreamPos := aStream.Position;
  6006. SetLength(magic, MAGIC_LEN);
  6007. aStream.Read(magic[1], MAGIC_LEN);
  6008. aStream.Position := StreamPos;
  6009. if (magic <> JPEG_MAGIC) then begin
  6010. result := false;
  6011. exit;
  6012. end;
  6013. reader := TFPReaderJPEG.Create;
  6014. intf := TLazIntfImage.Create(0, 0);
  6015. try try
  6016. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  6017. reader.ImageRead(aStream, intf);
  6018. AssignFromLazIntfImage(intf);
  6019. except
  6020. result := false;
  6021. aStream.Position := StreamPos;
  6022. exit;
  6023. end;
  6024. finally
  6025. reader.Free;
  6026. intf.Free;
  6027. end;
  6028. end;
  6029. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  6030. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6031. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6032. var
  6033. Surface: PSDL_Surface;
  6034. RWops: PSDL_RWops;
  6035. begin
  6036. result := false;
  6037. RWops := glBitmapCreateRWops(aStream);
  6038. try
  6039. if IMG_isJPG(RWops) > 0 then begin
  6040. Surface := IMG_LoadJPG_RW(RWops);
  6041. try
  6042. AssignFromSurface(Surface);
  6043. result := true;
  6044. finally
  6045. SDL_FreeSurface(Surface);
  6046. end;
  6047. end;
  6048. finally
  6049. SDL_FreeRW(RWops);
  6050. end;
  6051. end;
  6052. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  6053. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6054. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6055. var
  6056. StreamPos: Int64;
  6057. Temp: array[0..1]of Byte;
  6058. jpeg: jpeg_decompress_struct;
  6059. jpeg_err: jpeg_error_mgr;
  6060. IntFormat: TglBitmapFormat;
  6061. pImage: pByte;
  6062. TempHeight, TempWidth: Integer;
  6063. pTemp: pByte;
  6064. Row: Integer;
  6065. FormatDesc: TFormatDescriptor;
  6066. begin
  6067. result := false;
  6068. if not init_libJPEG then
  6069. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  6070. try
  6071. // reading first two bytes to test file and set cursor back to begin
  6072. StreamPos := aStream.Position;
  6073. aStream.Read({%H-}Temp[0], 2);
  6074. aStream.Position := StreamPos;
  6075. // if Bitmap then read file.
  6076. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  6077. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  6078. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  6079. // error managment
  6080. jpeg.err := jpeg_std_error(@jpeg_err);
  6081. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  6082. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  6083. // decompression struct
  6084. jpeg_create_decompress(@jpeg);
  6085. // allocation space for streaming methods
  6086. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  6087. // seeting up custom functions
  6088. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  6089. pub.init_source := glBitmap_libJPEG_init_source;
  6090. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  6091. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  6092. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  6093. pub.term_source := glBitmap_libJPEG_term_source;
  6094. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  6095. pub.next_input_byte := nil; // until buffer loaded
  6096. SrcStream := aStream;
  6097. end;
  6098. // set global decoding state
  6099. jpeg.global_state := DSTATE_START;
  6100. // read header of jpeg
  6101. jpeg_read_header(@jpeg, false);
  6102. // setting output parameter
  6103. case jpeg.jpeg_color_space of
  6104. JCS_GRAYSCALE:
  6105. begin
  6106. jpeg.out_color_space := JCS_GRAYSCALE;
  6107. IntFormat := tfLuminance8;
  6108. end;
  6109. else
  6110. jpeg.out_color_space := JCS_RGB;
  6111. IntFormat := tfRGB8;
  6112. end;
  6113. // reading image
  6114. jpeg_start_decompress(@jpeg);
  6115. TempHeight := jpeg.output_height;
  6116. TempWidth := jpeg.output_width;
  6117. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6118. // creating new image
  6119. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  6120. try
  6121. pTemp := pImage;
  6122. for Row := 0 to TempHeight -1 do begin
  6123. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  6124. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  6125. end;
  6126. // finish decompression
  6127. jpeg_finish_decompress(@jpeg);
  6128. // destroy decompression
  6129. jpeg_destroy_decompress(@jpeg);
  6130. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  6131. result := true;
  6132. except
  6133. if Assigned(pImage) then
  6134. FreeMem(pImage);
  6135. raise;
  6136. end;
  6137. end;
  6138. finally
  6139. quit_libJPEG;
  6140. end;
  6141. end;
  6142. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  6143. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6144. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  6145. var
  6146. bmp: TBitmap;
  6147. jpg: TJPEGImage;
  6148. StreamPos: Int64;
  6149. Temp: array[0..1]of Byte;
  6150. begin
  6151. result := false;
  6152. // reading first two bytes to test file and set cursor back to begin
  6153. StreamPos := aStream.Position;
  6154. aStream.Read(Temp[0], 2);
  6155. aStream.Position := StreamPos;
  6156. // if Bitmap then read file.
  6157. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  6158. bmp := TBitmap.Create;
  6159. try
  6160. jpg := TJPEGImage.Create;
  6161. try
  6162. jpg.LoadFromStream(aStream);
  6163. bmp.Assign(jpg);
  6164. result := AssignFromBitmap(bmp);
  6165. finally
  6166. jpg.Free;
  6167. end;
  6168. finally
  6169. bmp.Free;
  6170. end;
  6171. end;
  6172. end;
  6173. {$IFEND}
  6174. {$ENDIF}
  6175. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  6176. {$IF DEFINED(GLB_LAZ_JPEG)}
  6177. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6178. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6179. var
  6180. jpeg: TJPEGImage;
  6181. intf: TLazIntfImage;
  6182. raw: TRawImage;
  6183. begin
  6184. jpeg := TJPEGImage.Create;
  6185. intf := TLazIntfImage.Create(0, 0);
  6186. try
  6187. if not AssignToLazIntfImage(intf) then
  6188. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  6189. intf.GetRawImage(raw);
  6190. jpeg.LoadFromRawImage(raw, false);
  6191. jpeg.SaveToStream(aStream);
  6192. finally
  6193. intf.Free;
  6194. jpeg.Free;
  6195. end;
  6196. end;
  6197. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  6198. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6199. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6200. var
  6201. jpeg: jpeg_compress_struct;
  6202. jpeg_err: jpeg_error_mgr;
  6203. Row: Integer;
  6204. pTemp, pTemp2: pByte;
  6205. procedure CopyRow(pDest, pSource: pByte);
  6206. var
  6207. X: Integer;
  6208. begin
  6209. for X := 0 to Width - 1 do begin
  6210. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  6211. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  6212. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  6213. Inc(pDest, 3);
  6214. Inc(pSource, 3);
  6215. end;
  6216. end;
  6217. begin
  6218. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6219. raise EglBitmapUnsupportedFormat.Create(Format);
  6220. if not init_libJPEG then
  6221. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  6222. try
  6223. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  6224. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  6225. // error managment
  6226. jpeg.err := jpeg_std_error(@jpeg_err);
  6227. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  6228. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  6229. // compression struct
  6230. jpeg_create_compress(@jpeg);
  6231. // allocation space for streaming methods
  6232. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  6233. // seeting up custom functions
  6234. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  6235. pub.init_destination := glBitmap_libJPEG_init_destination;
  6236. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  6237. pub.term_destination := glBitmap_libJPEG_term_destination;
  6238. pub.next_output_byte := @DestBuffer[1];
  6239. pub.free_in_buffer := Length(DestBuffer);
  6240. DestStream := aStream;
  6241. end;
  6242. // very important state
  6243. jpeg.global_state := CSTATE_START;
  6244. jpeg.image_width := Width;
  6245. jpeg.image_height := Height;
  6246. case Format of
  6247. tfAlpha8, tfLuminance8: begin
  6248. jpeg.input_components := 1;
  6249. jpeg.in_color_space := JCS_GRAYSCALE;
  6250. end;
  6251. tfRGB8, tfBGR8: begin
  6252. jpeg.input_components := 3;
  6253. jpeg.in_color_space := JCS_RGB;
  6254. end;
  6255. end;
  6256. jpeg_set_defaults(@jpeg);
  6257. jpeg_set_quality(@jpeg, 95, true);
  6258. jpeg_start_compress(@jpeg, true);
  6259. pTemp := Data;
  6260. if Format = tfBGR8 then
  6261. GetMem(pTemp2, fRowSize)
  6262. else
  6263. pTemp2 := pTemp;
  6264. try
  6265. for Row := 0 to jpeg.image_height -1 do begin
  6266. // prepare row
  6267. if Format = tfBGR8 then
  6268. CopyRow(pTemp2, pTemp)
  6269. else
  6270. pTemp2 := pTemp;
  6271. // write row
  6272. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  6273. inc(pTemp, fRowSize);
  6274. end;
  6275. finally
  6276. // free memory
  6277. if Format = tfBGR8 then
  6278. FreeMem(pTemp2);
  6279. end;
  6280. jpeg_finish_compress(@jpeg);
  6281. jpeg_destroy_compress(@jpeg);
  6282. finally
  6283. quit_libJPEG;
  6284. end;
  6285. end;
  6286. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  6287. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6288. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  6289. var
  6290. Bmp: TBitmap;
  6291. Jpg: TJPEGImage;
  6292. begin
  6293. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  6294. raise EglBitmapUnsupportedFormat.Create(Format);
  6295. Bmp := TBitmap.Create;
  6296. try
  6297. Jpg := TJPEGImage.Create;
  6298. try
  6299. AssignToBitmap(Bmp);
  6300. if (Format in [tfAlpha8, tfLuminance8]) then begin
  6301. Jpg.Grayscale := true;
  6302. Jpg.PixelFormat := jf8Bit;
  6303. end;
  6304. Jpg.Assign(Bmp);
  6305. Jpg.SaveToStream(aStream);
  6306. finally
  6307. FreeAndNil(Jpg);
  6308. end;
  6309. finally
  6310. FreeAndNil(Bmp);
  6311. end;
  6312. end;
  6313. {$IFEND}
  6314. {$ENDIF}
  6315. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6316. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6317. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6318. const
  6319. BMP_MAGIC = $4D42;
  6320. BMP_COMP_RGB = 0;
  6321. BMP_COMP_RLE8 = 1;
  6322. BMP_COMP_RLE4 = 2;
  6323. BMP_COMP_BITFIELDS = 3;
  6324. type
  6325. TBMPHeader = packed record
  6326. bfType: Word;
  6327. bfSize: Cardinal;
  6328. bfReserved1: Word;
  6329. bfReserved2: Word;
  6330. bfOffBits: Cardinal;
  6331. end;
  6332. TBMPInfo = packed record
  6333. biSize: Cardinal;
  6334. biWidth: Longint;
  6335. biHeight: Longint;
  6336. biPlanes: Word;
  6337. biBitCount: Word;
  6338. biCompression: Cardinal;
  6339. biSizeImage: Cardinal;
  6340. biXPelsPerMeter: Longint;
  6341. biYPelsPerMeter: Longint;
  6342. biClrUsed: Cardinal;
  6343. biClrImportant: Cardinal;
  6344. end;
  6345. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6346. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  6347. //////////////////////////////////////////////////////////////////////////////////////////////////
  6348. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  6349. begin
  6350. result := tfEmpty;
  6351. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  6352. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  6353. //Read Compression
  6354. case aInfo.biCompression of
  6355. BMP_COMP_RLE4,
  6356. BMP_COMP_RLE8: begin
  6357. raise EglBitmap.Create('RLE compression is not supported');
  6358. end;
  6359. BMP_COMP_BITFIELDS: begin
  6360. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  6361. aStream.Read(aMask.r, SizeOf(aMask.r));
  6362. aStream.Read(aMask.g, SizeOf(aMask.g));
  6363. aStream.Read(aMask.b, SizeOf(aMask.b));
  6364. aStream.Read(aMask.a, SizeOf(aMask.a));
  6365. end else
  6366. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  6367. end;
  6368. end;
  6369. //get suitable format
  6370. case aInfo.biBitCount of
  6371. 8: result := tfLuminance8;
  6372. 16: result := tfX1RGB5;
  6373. 24: result := tfRGB8;
  6374. 32: result := tfXRGB8;
  6375. end;
  6376. end;
  6377. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  6378. var
  6379. i, c: Integer;
  6380. ColorTable: TbmpColorTable;
  6381. begin
  6382. result := nil;
  6383. if (aInfo.biBitCount >= 16) then
  6384. exit;
  6385. aFormat := tfLuminance8;
  6386. c := aInfo.biClrUsed;
  6387. if (c = 0) then
  6388. c := 1 shl aInfo.biBitCount;
  6389. SetLength(ColorTable, c);
  6390. for i := 0 to c-1 do begin
  6391. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  6392. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  6393. aFormat := tfRGB8;
  6394. end;
  6395. result := TbmpColorTableFormat.Create;
  6396. result.PixelSize := aInfo.biBitCount / 8;
  6397. result.ColorTable := ColorTable;
  6398. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  6399. end;
  6400. //////////////////////////////////////////////////////////////////////////////////////////////////
  6401. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  6402. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  6403. var
  6404. TmpFormat: TglBitmapFormat;
  6405. FormatDesc: TFormatDescriptor;
  6406. begin
  6407. result := nil;
  6408. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  6409. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6410. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  6411. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  6412. aFormat := FormatDesc.Format;
  6413. exit;
  6414. end;
  6415. end;
  6416. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  6417. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  6418. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  6419. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  6420. result := TbmpBitfieldFormat.Create;
  6421. result.PixelSize := aInfo.biBitCount / 8;
  6422. result.RedMask := aMask.r;
  6423. result.GreenMask := aMask.g;
  6424. result.BlueMask := aMask.b;
  6425. result.AlphaMask := aMask.a;
  6426. end;
  6427. end;
  6428. var
  6429. //simple types
  6430. StartPos: Int64;
  6431. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  6432. PaddingBuff: Cardinal;
  6433. LineBuf, ImageData, TmpData: PByte;
  6434. SourceMD, DestMD: Pointer;
  6435. BmpFormat: TglBitmapFormat;
  6436. //records
  6437. Mask: TglBitmapColorRec;
  6438. Header: TBMPHeader;
  6439. Info: TBMPInfo;
  6440. //classes
  6441. SpecialFormat: TFormatDescriptor;
  6442. FormatDesc: TFormatDescriptor;
  6443. //////////////////////////////////////////////////////////////////////////////////////////////////
  6444. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  6445. var
  6446. i: Integer;
  6447. Pixel: TglBitmapPixelData;
  6448. begin
  6449. aStream.Read(aLineBuf^, rbLineSize);
  6450. SpecialFormat.PreparePixel(Pixel);
  6451. for i := 0 to Info.biWidth-1 do begin
  6452. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  6453. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  6454. FormatDesc.Map(Pixel, aData, DestMD);
  6455. end;
  6456. end;
  6457. begin
  6458. result := false;
  6459. BmpFormat := tfEmpty;
  6460. SpecialFormat := nil;
  6461. LineBuf := nil;
  6462. SourceMD := nil;
  6463. DestMD := nil;
  6464. // Header
  6465. StartPos := aStream.Position;
  6466. aStream.Read(Header{%H-}, SizeOf(Header));
  6467. if Header.bfType = BMP_MAGIC then begin
  6468. try try
  6469. BmpFormat := ReadInfo(Info, Mask);
  6470. SpecialFormat := ReadColorTable(BmpFormat, Info);
  6471. if not Assigned(SpecialFormat) then
  6472. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  6473. aStream.Position := StartPos + Header.bfOffBits;
  6474. if (BmpFormat <> tfEmpty) then begin
  6475. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  6476. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  6477. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  6478. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  6479. //get Memory
  6480. DestMD := FormatDesc.CreateMappingData;
  6481. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  6482. GetMem(ImageData, ImageSize);
  6483. if Assigned(SpecialFormat) then begin
  6484. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  6485. SourceMD := SpecialFormat.CreateMappingData;
  6486. end;
  6487. //read Data
  6488. try try
  6489. FillChar(ImageData^, ImageSize, $FF);
  6490. TmpData := ImageData;
  6491. if (Info.biHeight > 0) then
  6492. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  6493. for i := 0 to Abs(Info.biHeight)-1 do begin
  6494. if Assigned(SpecialFormat) then
  6495. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  6496. else
  6497. aStream.Read(TmpData^, wbLineSize); //else only read data
  6498. if (Info.biHeight > 0) then
  6499. dec(TmpData, wbLineSize)
  6500. else
  6501. inc(TmpData, wbLineSize);
  6502. aStream.Read(PaddingBuff{%H-}, Padding);
  6503. end;
  6504. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6505. result := true;
  6506. finally
  6507. if Assigned(LineBuf) then
  6508. FreeMem(LineBuf);
  6509. if Assigned(SourceMD) then
  6510. SpecialFormat.FreeMappingData(SourceMD);
  6511. FormatDesc.FreeMappingData(DestMD);
  6512. end;
  6513. except
  6514. if Assigned(ImageData) then
  6515. FreeMem(ImageData);
  6516. raise;
  6517. end;
  6518. end else
  6519. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6520. except
  6521. aStream.Position := StartPos;
  6522. raise;
  6523. end;
  6524. finally
  6525. FreeAndNil(SpecialFormat);
  6526. end;
  6527. end
  6528. else aStream.Position := StartPos;
  6529. end;
  6530. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6531. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6532. var
  6533. Header: TBMPHeader;
  6534. Info: TBMPInfo;
  6535. Converter: TFormatDescriptor;
  6536. FormatDesc: TFormatDescriptor;
  6537. SourceFD, DestFD: Pointer;
  6538. pData, srcData, dstData, ConvertBuffer: pByte;
  6539. Pixel: TglBitmapPixelData;
  6540. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6541. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6542. PaddingBuff: Cardinal;
  6543. function GetLineWidth : Integer;
  6544. begin
  6545. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6546. end;
  6547. begin
  6548. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6549. raise EglBitmapUnsupportedFormat.Create(Format);
  6550. Converter := nil;
  6551. FormatDesc := TFormatDescriptor.Get(Format);
  6552. ImageSize := FormatDesc.GetSize(Dimension);
  6553. FillChar(Header{%H-}, SizeOf(Header), 0);
  6554. Header.bfType := BMP_MAGIC;
  6555. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6556. Header.bfReserved1 := 0;
  6557. Header.bfReserved2 := 0;
  6558. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6559. FillChar(Info{%H-}, SizeOf(Info), 0);
  6560. Info.biSize := SizeOf(Info);
  6561. Info.biWidth := Width;
  6562. Info.biHeight := Height;
  6563. Info.biPlanes := 1;
  6564. Info.biCompression := BMP_COMP_RGB;
  6565. Info.biSizeImage := ImageSize;
  6566. try
  6567. case Format of
  6568. tfLuminance4: begin
  6569. Info.biBitCount := 4;
  6570. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  6571. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  6572. Converter := TbmpColorTableFormat.Create;
  6573. with (Converter as TbmpColorTableFormat) do begin
  6574. PixelSize := 0.5;
  6575. Format := Format;
  6576. Range := glBitmapColorRec($F, $F, $F, $0);
  6577. CreateColorTable;
  6578. end;
  6579. end;
  6580. tfR3G3B2, tfLuminance8: begin
  6581. Info.biBitCount := 8;
  6582. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6583. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6584. Converter := TbmpColorTableFormat.Create;
  6585. with (Converter as TbmpColorTableFormat) do begin
  6586. PixelSize := 1;
  6587. Format := Format;
  6588. if (Format = tfR3G3B2) then begin
  6589. Range := glBitmapColorRec($7, $7, $3, $0);
  6590. Shift := glBitmapShiftRec(0, 3, 6, 0);
  6591. end else
  6592. Range := glBitmapColorRec($FF, $FF, $FF, $0);
  6593. CreateColorTable;
  6594. end;
  6595. end;
  6596. tfRGBX4, tfXRGB4, tfRGB5X1, tfX1RGB5, tfR5G6B5, tfRGB5A1, tfA1RGB5, tfRGBA4, tfARGB4,
  6597. tfBGRX4, tfXBGR4, tfBGR5X1, tfX1BGR5, tfB5G6R5, tfBGR5A1, tfA1BGR5, tfBGRA4, tfABGR4: begin
  6598. Info.biBitCount := 16;
  6599. Info.biCompression := BMP_COMP_BITFIELDS;
  6600. end;
  6601. tfBGR8, tfRGB8: begin
  6602. Info.biBitCount := 24;
  6603. if (Format = tfRGB8) then
  6604. Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6605. end;
  6606. tfRGB10X2, tfX2RGB10, tfRGB10A2, tfA2RGB10, tfRGBA8, tfARGB8,
  6607. tfBGR10X2, tfX2BGR10, tfBGR10A2, tfA2BGR10, tfBGRA8, tfABGR8: begin
  6608. Info.biBitCount := 32;
  6609. Info.biCompression := BMP_COMP_BITFIELDS;
  6610. end;
  6611. else
  6612. raise EglBitmapUnsupportedFormat.Create(Format);
  6613. end;
  6614. Info.biXPelsPerMeter := 2835;
  6615. Info.biYPelsPerMeter := 2835;
  6616. // prepare bitmasks
  6617. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6618. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6619. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6620. RedMask := FormatDesc.RedMask;
  6621. GreenMask := FormatDesc.GreenMask;
  6622. BlueMask := FormatDesc.BlueMask;
  6623. AlphaMask := FormatDesc.AlphaMask;
  6624. end;
  6625. // headers
  6626. aStream.Write(Header, SizeOf(Header));
  6627. aStream.Write(Info, SizeOf(Info));
  6628. // colortable
  6629. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6630. with (Converter as TbmpColorTableFormat) do
  6631. aStream.Write(ColorTable[0].b,
  6632. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6633. // bitmasks
  6634. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6635. aStream.Write(RedMask, SizeOf(Cardinal));
  6636. aStream.Write(GreenMask, SizeOf(Cardinal));
  6637. aStream.Write(BlueMask, SizeOf(Cardinal));
  6638. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6639. end;
  6640. // image data
  6641. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  6642. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6643. Padding := GetLineWidth - wbLineSize;
  6644. PaddingBuff := 0;
  6645. pData := Data;
  6646. inc(pData, (Height-1) * rbLineSize);
  6647. // prepare row buffer. But only for RGB because RGBA supports color masks
  6648. // so it's possible to change color within the image.
  6649. if Assigned(Converter) then begin
  6650. FormatDesc.PreparePixel(Pixel);
  6651. GetMem(ConvertBuffer, wbLineSize);
  6652. SourceFD := FormatDesc.CreateMappingData;
  6653. DestFD := Converter.CreateMappingData;
  6654. end else
  6655. ConvertBuffer := nil;
  6656. try
  6657. for LineIdx := 0 to Height - 1 do begin
  6658. // preparing row
  6659. if Assigned(Converter) then begin
  6660. srcData := pData;
  6661. dstData := ConvertBuffer;
  6662. for PixelIdx := 0 to Info.biWidth-1 do begin
  6663. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6664. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6665. Converter.Map(Pixel, dstData, DestFD);
  6666. end;
  6667. aStream.Write(ConvertBuffer^, wbLineSize);
  6668. end else begin
  6669. aStream.Write(pData^, rbLineSize);
  6670. end;
  6671. dec(pData, rbLineSize);
  6672. if (Padding > 0) then
  6673. aStream.Write(PaddingBuff, Padding);
  6674. end;
  6675. finally
  6676. // destroy row buffer
  6677. if Assigned(ConvertBuffer) then begin
  6678. FormatDesc.FreeMappingData(SourceFD);
  6679. Converter.FreeMappingData(DestFD);
  6680. FreeMem(ConvertBuffer);
  6681. end;
  6682. end;
  6683. finally
  6684. if Assigned(Converter) then
  6685. Converter.Free;
  6686. end;
  6687. end;
  6688. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6689. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6690. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6691. type
  6692. TTGAHeader = packed record
  6693. ImageID: Byte;
  6694. ColorMapType: Byte;
  6695. ImageType: Byte;
  6696. //ColorMapSpec: Array[0..4] of Byte;
  6697. ColorMapStart: Word;
  6698. ColorMapLength: Word;
  6699. ColorMapEntrySize: Byte;
  6700. OrigX: Word;
  6701. OrigY: Word;
  6702. Width: Word;
  6703. Height: Word;
  6704. Bpp: Byte;
  6705. ImageDesc: Byte;
  6706. end;
  6707. const
  6708. TGA_UNCOMPRESSED_RGB = 2;
  6709. TGA_UNCOMPRESSED_GRAY = 3;
  6710. TGA_COMPRESSED_RGB = 10;
  6711. TGA_COMPRESSED_GRAY = 11;
  6712. TGA_NONE_COLOR_TABLE = 0;
  6713. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6714. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6715. var
  6716. Header: TTGAHeader;
  6717. ImageData: System.PByte;
  6718. StartPosition: Int64;
  6719. PixelSize, LineSize: Integer;
  6720. tgaFormat: TglBitmapFormat;
  6721. FormatDesc: TFormatDescriptor;
  6722. Counter: packed record
  6723. X, Y: packed record
  6724. low, high, dir: Integer;
  6725. end;
  6726. end;
  6727. const
  6728. CACHE_SIZE = $4000;
  6729. ////////////////////////////////////////////////////////////////////////////////////////
  6730. procedure ReadUncompressed;
  6731. var
  6732. i, j: Integer;
  6733. buf, tmp1, tmp2: System.PByte;
  6734. begin
  6735. buf := nil;
  6736. if (Counter.X.dir < 0) then
  6737. GetMem(buf, LineSize);
  6738. try
  6739. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6740. tmp1 := ImageData;
  6741. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6742. if (Counter.X.dir < 0) then begin //flip X
  6743. aStream.Read(buf^, LineSize);
  6744. tmp2 := buf;
  6745. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6746. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6747. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6748. tmp1^ := tmp2^;
  6749. inc(tmp1);
  6750. inc(tmp2);
  6751. end;
  6752. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6753. end;
  6754. end else
  6755. aStream.Read(tmp1^, LineSize);
  6756. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6757. end;
  6758. finally
  6759. if Assigned(buf) then
  6760. FreeMem(buf);
  6761. end;
  6762. end;
  6763. ////////////////////////////////////////////////////////////////////////////////////////
  6764. procedure ReadCompressed;
  6765. /////////////////////////////////////////////////////////////////
  6766. var
  6767. TmpData: System.PByte;
  6768. LinePixelsRead: Integer;
  6769. procedure CheckLine;
  6770. begin
  6771. if (LinePixelsRead >= Header.Width) then begin
  6772. LinePixelsRead := 0;
  6773. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6774. TmpData := ImageData;
  6775. inc(TmpData, Counter.Y.low * LineSize); //set line
  6776. if (Counter.X.dir < 0) then //if x flipped then
  6777. inc(TmpData, LineSize - PixelSize); //set last pixel
  6778. end;
  6779. end;
  6780. /////////////////////////////////////////////////////////////////
  6781. var
  6782. Cache: PByte;
  6783. CacheSize, CachePos: Integer;
  6784. procedure CachedRead(out Buffer; Count: Integer);
  6785. var
  6786. BytesRead: Integer;
  6787. begin
  6788. if (CachePos + Count > CacheSize) then begin
  6789. //if buffer overflow save non read bytes
  6790. BytesRead := 0;
  6791. if (CacheSize - CachePos > 0) then begin
  6792. BytesRead := CacheSize - CachePos;
  6793. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6794. inc(CachePos, BytesRead);
  6795. end;
  6796. //load cache from file
  6797. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6798. aStream.Read(Cache^, CacheSize);
  6799. CachePos := 0;
  6800. //read rest of requested bytes
  6801. if (Count - BytesRead > 0) then begin
  6802. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6803. inc(CachePos, Count - BytesRead);
  6804. end;
  6805. end else begin
  6806. //if no buffer overflow just read the data
  6807. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6808. inc(CachePos, Count);
  6809. end;
  6810. end;
  6811. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6812. begin
  6813. case PixelSize of
  6814. 1: begin
  6815. aBuffer^ := aData^;
  6816. inc(aBuffer, Counter.X.dir);
  6817. end;
  6818. 2: begin
  6819. PWord(aBuffer)^ := PWord(aData)^;
  6820. inc(aBuffer, 2 * Counter.X.dir);
  6821. end;
  6822. 3: begin
  6823. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6824. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6825. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6826. inc(aBuffer, 3 * Counter.X.dir);
  6827. end;
  6828. 4: begin
  6829. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6830. inc(aBuffer, 4 * Counter.X.dir);
  6831. end;
  6832. end;
  6833. end;
  6834. var
  6835. TotalPixelsToRead, TotalPixelsRead: Integer;
  6836. Temp: Byte;
  6837. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6838. PixelRepeat: Boolean;
  6839. PixelsToRead, PixelCount: Integer;
  6840. begin
  6841. CacheSize := 0;
  6842. CachePos := 0;
  6843. TotalPixelsToRead := Header.Width * Header.Height;
  6844. TotalPixelsRead := 0;
  6845. LinePixelsRead := 0;
  6846. GetMem(Cache, CACHE_SIZE);
  6847. try
  6848. TmpData := ImageData;
  6849. inc(TmpData, Counter.Y.low * LineSize); //set line
  6850. if (Counter.X.dir < 0) then //if x flipped then
  6851. inc(TmpData, LineSize - PixelSize); //set last pixel
  6852. repeat
  6853. //read CommandByte
  6854. CachedRead(Temp, 1);
  6855. PixelRepeat := (Temp and $80) > 0;
  6856. PixelsToRead := (Temp and $7F) + 1;
  6857. inc(TotalPixelsRead, PixelsToRead);
  6858. if PixelRepeat then
  6859. CachedRead(buf[0], PixelSize);
  6860. while (PixelsToRead > 0) do begin
  6861. CheckLine;
  6862. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6863. while (PixelCount > 0) do begin
  6864. if not PixelRepeat then
  6865. CachedRead(buf[0], PixelSize);
  6866. PixelToBuffer(@buf[0], TmpData);
  6867. inc(LinePixelsRead);
  6868. dec(PixelsToRead);
  6869. dec(PixelCount);
  6870. end;
  6871. end;
  6872. until (TotalPixelsRead >= TotalPixelsToRead);
  6873. finally
  6874. FreeMem(Cache);
  6875. end;
  6876. end;
  6877. function IsGrayFormat: Boolean;
  6878. begin
  6879. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6880. end;
  6881. begin
  6882. result := false;
  6883. // reading header to test file and set cursor back to begin
  6884. StartPosition := aStream.Position;
  6885. aStream.Read(Header{%H-}, SizeOf(Header));
  6886. // no colormapped files
  6887. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6888. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6889. begin
  6890. try
  6891. if Header.ImageID <> 0 then // skip image ID
  6892. aStream.Position := aStream.Position + Header.ImageID;
  6893. tgaFormat := tfEmpty;
  6894. case Header.Bpp of
  6895. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6896. 0: tgaFormat := tfLuminance8;
  6897. 8: tgaFormat := tfAlpha8;
  6898. end;
  6899. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6900. 0: tgaFormat := tfLuminance16;
  6901. 8: tgaFormat := tfLuminance8Alpha8;
  6902. end else case (Header.ImageDesc and $F) of
  6903. 0: tgaFormat := tfX1RGB5;
  6904. 1: tgaFormat := tfA1RGB5;
  6905. 4: tgaFormat := tfARGB4;
  6906. end;
  6907. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6908. 0: tgaFormat := tfRGB8;
  6909. end;
  6910. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6911. 2: tgaFormat := tfA2RGB10;
  6912. 8: tgaFormat := tfARGB8;
  6913. end;
  6914. end;
  6915. if (tgaFormat = tfEmpty) then
  6916. raise EglBitmap.Create('LoadTga - unsupported format');
  6917. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6918. PixelSize := FormatDesc.GetSize(1, 1);
  6919. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6920. GetMem(ImageData, LineSize * Header.Height);
  6921. try
  6922. //column direction
  6923. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6924. Counter.X.low := Header.Height-1;;
  6925. Counter.X.high := 0;
  6926. Counter.X.dir := -1;
  6927. end else begin
  6928. Counter.X.low := 0;
  6929. Counter.X.high := Header.Height-1;
  6930. Counter.X.dir := 1;
  6931. end;
  6932. // Row direction
  6933. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6934. Counter.Y.low := 0;
  6935. Counter.Y.high := Header.Height-1;
  6936. Counter.Y.dir := 1;
  6937. end else begin
  6938. Counter.Y.low := Header.Height-1;;
  6939. Counter.Y.high := 0;
  6940. Counter.Y.dir := -1;
  6941. end;
  6942. // Read Image
  6943. case Header.ImageType of
  6944. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6945. ReadUncompressed;
  6946. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6947. ReadCompressed;
  6948. end;
  6949. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6950. result := true;
  6951. except
  6952. if Assigned(ImageData) then
  6953. FreeMem(ImageData);
  6954. raise;
  6955. end;
  6956. finally
  6957. aStream.Position := StartPosition;
  6958. end;
  6959. end
  6960. else aStream.Position := StartPosition;
  6961. end;
  6962. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6963. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6964. var
  6965. Header: TTGAHeader;
  6966. LineSize, Size, x, y: Integer;
  6967. Pixel: TglBitmapPixelData;
  6968. LineBuf, SourceData, DestData: PByte;
  6969. SourceMD, DestMD: Pointer;
  6970. FormatDesc: TFormatDescriptor;
  6971. Converter: TFormatDescriptor;
  6972. begin
  6973. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6974. raise EglBitmapUnsupportedFormat.Create(Format);
  6975. //prepare header
  6976. FillChar(Header{%H-}, SizeOf(Header), 0);
  6977. //set ImageType
  6978. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6979. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6980. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6981. else
  6982. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6983. //set BitsPerPixel
  6984. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6985. Header.Bpp := 8
  6986. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6987. tfRGB5X1, tfBGR5X1, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6988. Header.Bpp := 16
  6989. else if (Format in [tfBGR8, tfRGB8]) then
  6990. Header.Bpp := 24
  6991. else
  6992. Header.Bpp := 32;
  6993. //set AlphaBitCount
  6994. case Format of
  6995. tfRGB5A1, tfBGR5A1:
  6996. Header.ImageDesc := 1 and $F;
  6997. tfRGB10A2, tfBGR10A2:
  6998. Header.ImageDesc := 2 and $F;
  6999. tfRGBA4, tfBGRA4:
  7000. Header.ImageDesc := 4 and $F;
  7001. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  7002. Header.ImageDesc := 8 and $F;
  7003. end;
  7004. Header.Width := Width;
  7005. Header.Height := Height;
  7006. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  7007. aStream.Write(Header, SizeOf(Header));
  7008. // convert RGB(A) to BGR(A)
  7009. Converter := nil;
  7010. FormatDesc := TFormatDescriptor.Get(Format);
  7011. Size := FormatDesc.GetSize(Dimension);
  7012. if Format in [tfRGB5X1, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  7013. if (FormatDesc.RGBInverted = tfEmpty) then
  7014. raise EglBitmap.Create('inverted RGB format is empty');
  7015. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  7016. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  7017. (Converter.PixelSize <> FormatDesc.PixelSize) then
  7018. raise EglBitmap.Create('invalid inverted RGB format');
  7019. end;
  7020. if Assigned(Converter) then begin
  7021. LineSize := FormatDesc.GetSize(Width, 1);
  7022. GetMem(LineBuf, LineSize);
  7023. SourceMD := FormatDesc.CreateMappingData;
  7024. DestMD := Converter.CreateMappingData;
  7025. try
  7026. SourceData := Data;
  7027. for y := 0 to Height-1 do begin
  7028. DestData := LineBuf;
  7029. for x := 0 to Width-1 do begin
  7030. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  7031. Converter.Map(Pixel, DestData, DestMD);
  7032. end;
  7033. aStream.Write(LineBuf^, LineSize);
  7034. end;
  7035. finally
  7036. FreeMem(LineBuf);
  7037. FormatDesc.FreeMappingData(SourceMD);
  7038. FormatDesc.FreeMappingData(DestMD);
  7039. end;
  7040. end else
  7041. aStream.Write(Data^, Size);
  7042. end;
  7043. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7044. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7046. const
  7047. DDS_MAGIC: Cardinal = $20534444;
  7048. // DDS_header.dwFlags
  7049. DDSD_CAPS = $00000001;
  7050. DDSD_HEIGHT = $00000002;
  7051. DDSD_WIDTH = $00000004;
  7052. DDSD_PIXELFORMAT = $00001000;
  7053. // DDS_header.sPixelFormat.dwFlags
  7054. DDPF_ALPHAPIXELS = $00000001;
  7055. DDPF_ALPHA = $00000002;
  7056. DDPF_FOURCC = $00000004;
  7057. DDPF_RGB = $00000040;
  7058. DDPF_LUMINANCE = $00020000;
  7059. // DDS_header.sCaps.dwCaps1
  7060. DDSCAPS_TEXTURE = $00001000;
  7061. // DDS_header.sCaps.dwCaps2
  7062. DDSCAPS2_CUBEMAP = $00000200;
  7063. D3DFMT_DXT1 = $31545844;
  7064. D3DFMT_DXT3 = $33545844;
  7065. D3DFMT_DXT5 = $35545844;
  7066. type
  7067. TDDSPixelFormat = packed record
  7068. dwSize: Cardinal;
  7069. dwFlags: Cardinal;
  7070. dwFourCC: Cardinal;
  7071. dwRGBBitCount: Cardinal;
  7072. dwRBitMask: Cardinal;
  7073. dwGBitMask: Cardinal;
  7074. dwBBitMask: Cardinal;
  7075. dwABitMask: Cardinal;
  7076. end;
  7077. TDDSCaps = packed record
  7078. dwCaps1: Cardinal;
  7079. dwCaps2: Cardinal;
  7080. dwDDSX: Cardinal;
  7081. dwReserved: Cardinal;
  7082. end;
  7083. TDDSHeader = packed record
  7084. dwSize: Cardinal;
  7085. dwFlags: Cardinal;
  7086. dwHeight: Cardinal;
  7087. dwWidth: Cardinal;
  7088. dwPitchOrLinearSize: Cardinal;
  7089. dwDepth: Cardinal;
  7090. dwMipMapCount: Cardinal;
  7091. dwReserved: array[0..10] of Cardinal;
  7092. PixelFormat: TDDSPixelFormat;
  7093. Caps: TDDSCaps;
  7094. dwReserved2: Cardinal;
  7095. end;
  7096. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7097. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  7098. var
  7099. Header: TDDSHeader;
  7100. Converter: TbmpBitfieldFormat;
  7101. function GetDDSFormat: TglBitmapFormat;
  7102. var
  7103. fd: TFormatDescriptor;
  7104. i: Integer;
  7105. Range: TglBitmapColorRec;
  7106. match: Boolean;
  7107. begin
  7108. result := tfEmpty;
  7109. with Header.PixelFormat do begin
  7110. // Compresses
  7111. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  7112. case Header.PixelFormat.dwFourCC of
  7113. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  7114. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  7115. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  7116. end;
  7117. end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  7118. // prepare masks
  7119. if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
  7120. Range.r := dwRBitMask;
  7121. Range.g := dwGBitMask;
  7122. Range.b := dwBBitMask;
  7123. end else begin
  7124. Range.r := dwRBitMask;
  7125. Range.g := dwRBitMask;
  7126. Range.b := dwRBitMask;
  7127. end;
  7128. Range.a := dwABitMask;
  7129. //find matching format
  7130. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  7131. fd := TFormatDescriptor.Get(result);
  7132. if fd.MaskMatch(Range.r, Range.g, Range.b, Range.a) and
  7133. (8 * fd.PixelSize = dwRGBBitCount) then
  7134. exit;
  7135. end;
  7136. //find format with same Range
  7137. for i := 0 to 3 do begin
  7138. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  7139. Range.arr[i] := Range.arr[i] shr 1;
  7140. end;
  7141. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  7142. fd := TFormatDescriptor.Get(result);
  7143. match := true;
  7144. for i := 0 to 3 do
  7145. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  7146. match := false;
  7147. break;
  7148. end;
  7149. if match then
  7150. break;
  7151. end;
  7152. //no format with same range found -> use default
  7153. if (result = tfEmpty) then begin
  7154. if (dwABitMask > 0) then
  7155. result := tfRGBA8
  7156. else
  7157. result := tfRGB8;
  7158. end;
  7159. Converter := TbmpBitfieldFormat.Create;
  7160. Converter.RedMask := dwRBitMask;
  7161. Converter.GreenMask := dwGBitMask;
  7162. Converter.BlueMask := dwBBitMask;
  7163. Converter.AlphaMask := dwABitMask;
  7164. Converter.PixelSize := dwRGBBitCount / 8;
  7165. end;
  7166. end;
  7167. end;
  7168. var
  7169. StreamPos: Int64;
  7170. x, y, LineSize, RowSize, Magic: Cardinal;
  7171. NewImage, TmpData, RowData, SrcData: System.PByte;
  7172. SourceMD, DestMD: Pointer;
  7173. Pixel: TglBitmapPixelData;
  7174. ddsFormat: TglBitmapFormat;
  7175. FormatDesc: TFormatDescriptor;
  7176. begin
  7177. result := false;
  7178. Converter := nil;
  7179. StreamPos := aStream.Position;
  7180. // Magic
  7181. aStream.Read(Magic{%H-}, sizeof(Magic));
  7182. if (Magic <> DDS_MAGIC) then begin
  7183. aStream.Position := StreamPos;
  7184. exit;
  7185. end;
  7186. //Header
  7187. aStream.Read(Header{%H-}, sizeof(Header));
  7188. if (Header.dwSize <> SizeOf(Header)) or
  7189. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  7190. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  7191. begin
  7192. aStream.Position := StreamPos;
  7193. exit;
  7194. end;
  7195. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  7196. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  7197. ddsFormat := GetDDSFormat;
  7198. try
  7199. if (ddsFormat = tfEmpty) then
  7200. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  7201. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  7202. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  7203. GetMem(NewImage, Header.dwHeight * LineSize);
  7204. try
  7205. TmpData := NewImage;
  7206. //Converter needed
  7207. if Assigned(Converter) then begin
  7208. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  7209. GetMem(RowData, RowSize);
  7210. SourceMD := Converter.CreateMappingData;
  7211. DestMD := FormatDesc.CreateMappingData;
  7212. try
  7213. for y := 0 to Header.dwHeight-1 do begin
  7214. TmpData := NewImage;
  7215. inc(TmpData, y * LineSize);
  7216. SrcData := RowData;
  7217. aStream.Read(SrcData^, RowSize);
  7218. for x := 0 to Header.dwWidth-1 do begin
  7219. Converter.Unmap(SrcData, Pixel, SourceMD);
  7220. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  7221. FormatDesc.Map(Pixel, TmpData, DestMD);
  7222. end;
  7223. end;
  7224. finally
  7225. Converter.FreeMappingData(SourceMD);
  7226. FormatDesc.FreeMappingData(DestMD);
  7227. FreeMem(RowData);
  7228. end;
  7229. end else
  7230. // Compressed
  7231. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  7232. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  7233. for Y := 0 to Header.dwHeight-1 do begin
  7234. aStream.Read(TmpData^, RowSize);
  7235. Inc(TmpData, LineSize);
  7236. end;
  7237. end else
  7238. // Uncompressed
  7239. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  7240. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  7241. for Y := 0 to Header.dwHeight-1 do begin
  7242. aStream.Read(TmpData^, RowSize);
  7243. Inc(TmpData, LineSize);
  7244. end;
  7245. end else
  7246. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  7247. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  7248. result := true;
  7249. except
  7250. if Assigned(NewImage) then
  7251. FreeMem(NewImage);
  7252. raise;
  7253. end;
  7254. finally
  7255. FreeAndNil(Converter);
  7256. end;
  7257. end;
  7258. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7259. procedure TglBitmap.SaveDDS(const aStream: TStream);
  7260. var
  7261. Header: TDDSHeader;
  7262. FormatDesc: TFormatDescriptor;
  7263. begin
  7264. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  7265. raise EglBitmapUnsupportedFormat.Create(Format);
  7266. FormatDesc := TFormatDescriptor.Get(Format);
  7267. // Generell
  7268. FillChar(Header{%H-}, SizeOf(Header), 0);
  7269. Header.dwSize := SizeOf(Header);
  7270. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  7271. Header.dwWidth := Max(1, Width);
  7272. Header.dwHeight := Max(1, Height);
  7273. // Caps
  7274. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  7275. // Pixelformat
  7276. Header.PixelFormat.dwSize := sizeof(Header);
  7277. if (FormatDesc.IsCompressed) then begin
  7278. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  7279. case Format of
  7280. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  7281. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  7282. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  7283. end;
  7284. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  7285. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  7286. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  7287. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  7288. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  7289. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  7290. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  7291. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  7292. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  7293. end else begin
  7294. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  7295. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  7296. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  7297. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  7298. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  7299. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  7300. end;
  7301. if (FormatDesc.HasAlpha) then
  7302. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  7303. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  7304. aStream.Write(Header, SizeOf(Header));
  7305. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  7306. end;
  7307. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7308. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7309. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7310. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7311. const aWidth: Integer; const aHeight: Integer);
  7312. var
  7313. pTemp: pByte;
  7314. Size: Integer;
  7315. begin
  7316. if (aHeight > 1) then begin
  7317. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  7318. GetMem(pTemp, Size);
  7319. try
  7320. Move(aData^, pTemp^, Size);
  7321. FreeMem(aData);
  7322. aData := nil;
  7323. except
  7324. FreeMem(pTemp);
  7325. raise;
  7326. end;
  7327. end else
  7328. pTemp := aData;
  7329. inherited SetDataPointer(pTemp, aFormat, aWidth);
  7330. end;
  7331. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7332. function TglBitmap1D.FlipHorz: Boolean;
  7333. var
  7334. Col: Integer;
  7335. pTempDest, pDest, pSource: PByte;
  7336. begin
  7337. result := inherited FlipHorz;
  7338. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  7339. pSource := Data;
  7340. GetMem(pDest, fRowSize);
  7341. try
  7342. pTempDest := pDest;
  7343. Inc(pTempDest, fRowSize);
  7344. for Col := 0 to Width-1 do begin
  7345. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  7346. Move(pSource^, pTempDest^, fPixelSize);
  7347. Inc(pSource, fPixelSize);
  7348. end;
  7349. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  7350. result := true;
  7351. except
  7352. if Assigned(pDest) then
  7353. FreeMem(pDest);
  7354. raise;
  7355. end;
  7356. end;
  7357. end;
  7358. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7359. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  7360. var
  7361. FormatDesc: TFormatDescriptor;
  7362. begin
  7363. // Upload data
  7364. FormatDesc := TFormatDescriptor.Get(Format);
  7365. if FormatDesc.IsCompressed then begin
  7366. if not Assigned(glCompressedTexImage1D) then
  7367. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7368. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  7369. end else if aBuildWithGlu then
  7370. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7371. else
  7372. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7373. // Free Data
  7374. if (FreeDataAfterGenTexture) then
  7375. FreeData;
  7376. end;
  7377. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7378. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  7379. var
  7380. BuildWithGlu, TexRec: Boolean;
  7381. TexSize: Integer;
  7382. begin
  7383. if Assigned(Data) then begin
  7384. // Check Texture Size
  7385. if (aTestTextureSize) then begin
  7386. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7387. if (Width > TexSize) then
  7388. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7389. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7390. (Target = GL_TEXTURE_RECTANGLE);
  7391. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7392. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7393. end;
  7394. CreateId;
  7395. SetupParameters(BuildWithGlu);
  7396. UploadData(BuildWithGlu);
  7397. glAreTexturesResident(1, @fID, @fIsResident);
  7398. end;
  7399. end;
  7400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7401. procedure TglBitmap1D.AfterConstruction;
  7402. begin
  7403. inherited;
  7404. Target := GL_TEXTURE_1D;
  7405. end;
  7406. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7407. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7408. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7409. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  7410. begin
  7411. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  7412. result := fLines[aIndex]
  7413. else
  7414. result := nil;
  7415. end;
  7416. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7417. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  7418. const aWidth: Integer; const aHeight: Integer);
  7419. var
  7420. Idx, LineWidth: Integer;
  7421. begin
  7422. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  7423. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  7424. // Assigning Data
  7425. if Assigned(Data) then begin
  7426. SetLength(fLines, GetHeight);
  7427. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  7428. for Idx := 0 to GetHeight-1 do begin
  7429. fLines[Idx] := Data;
  7430. Inc(fLines[Idx], Idx * LineWidth);
  7431. end;
  7432. end
  7433. else SetLength(fLines, 0);
  7434. end else begin
  7435. SetLength(fLines, 0);
  7436. end;
  7437. end;
  7438. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7439. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  7440. var
  7441. FormatDesc: TFormatDescriptor;
  7442. begin
  7443. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7444. FormatDesc := TFormatDescriptor.Get(Format);
  7445. if FormatDesc.IsCompressed then begin
  7446. if not Assigned(glCompressedTexImage2D) then
  7447. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7448. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  7449. end else if aBuildWithGlu then begin
  7450. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  7451. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7452. end else begin
  7453. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  7454. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7455. end;
  7456. // Freigeben
  7457. if (FreeDataAfterGenTexture) then
  7458. FreeData;
  7459. end;
  7460. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7461. procedure TglBitmap2D.AfterConstruction;
  7462. begin
  7463. inherited;
  7464. Target := GL_TEXTURE_2D;
  7465. end;
  7466. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7467. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  7468. var
  7469. Temp: pByte;
  7470. Size, w, h: Integer;
  7471. FormatDesc: TFormatDescriptor;
  7472. begin
  7473. FormatDesc := TFormatDescriptor.Get(aFormat);
  7474. if FormatDesc.IsCompressed then
  7475. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7476. w := aRight - aLeft;
  7477. h := aBottom - aTop;
  7478. Size := FormatDesc.GetSize(w, h);
  7479. GetMem(Temp, Size);
  7480. try
  7481. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7482. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7483. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  7484. FlipVert;
  7485. except
  7486. if Assigned(Temp) then
  7487. FreeMem(Temp);
  7488. raise;
  7489. end;
  7490. end;
  7491. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7492. procedure TglBitmap2D.GetDataFromTexture;
  7493. var
  7494. Temp: PByte;
  7495. TempWidth, TempHeight: Integer;
  7496. TempIntFormat: GLint;
  7497. IntFormat: TglBitmapFormat;
  7498. FormatDesc: TFormatDescriptor;
  7499. begin
  7500. Bind;
  7501. // Request Data
  7502. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7503. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7504. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7505. IntFormat := tfEmpty;
  7506. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7507. IntFormat := FormatDesc.Format;
  7508. // Getting data from OpenGL
  7509. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7510. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7511. try
  7512. if FormatDesc.IsCompressed then begin
  7513. if not Assigned(glGetCompressedTexImage) then
  7514. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7515. glGetCompressedTexImage(Target, 0, Temp)
  7516. end else
  7517. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7518. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7519. except
  7520. if Assigned(Temp) then
  7521. FreeMem(Temp);
  7522. raise;
  7523. end;
  7524. end;
  7525. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7526. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7527. var
  7528. BuildWithGlu, PotTex, TexRec: Boolean;
  7529. TexSize: Integer;
  7530. begin
  7531. if Assigned(Data) then begin
  7532. // Check Texture Size
  7533. if (aTestTextureSize) then begin
  7534. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7535. if ((Height > TexSize) or (Width > TexSize)) then
  7536. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7537. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7538. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7539. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7540. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7541. end;
  7542. CreateId;
  7543. SetupParameters(BuildWithGlu);
  7544. UploadData(Target, BuildWithGlu);
  7545. glAreTexturesResident(1, @fID, @fIsResident);
  7546. end;
  7547. end;
  7548. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7549. function TglBitmap2D.FlipHorz: Boolean;
  7550. var
  7551. Col, Row: Integer;
  7552. TempDestData, DestData, SourceData: PByte;
  7553. ImgSize: Integer;
  7554. begin
  7555. result := inherited FlipHorz;
  7556. if Assigned(Data) then begin
  7557. SourceData := Data;
  7558. ImgSize := Height * fRowSize;
  7559. GetMem(DestData, ImgSize);
  7560. try
  7561. TempDestData := DestData;
  7562. Dec(TempDestData, fRowSize + fPixelSize);
  7563. for Row := 0 to Height -1 do begin
  7564. Inc(TempDestData, fRowSize * 2);
  7565. for Col := 0 to Width -1 do begin
  7566. Move(SourceData^, TempDestData^, fPixelSize);
  7567. Inc(SourceData, fPixelSize);
  7568. Dec(TempDestData, fPixelSize);
  7569. end;
  7570. end;
  7571. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7572. result := true;
  7573. except
  7574. if Assigned(DestData) then
  7575. FreeMem(DestData);
  7576. raise;
  7577. end;
  7578. end;
  7579. end;
  7580. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7581. function TglBitmap2D.FlipVert: Boolean;
  7582. var
  7583. Row: Integer;
  7584. TempDestData, DestData, SourceData: PByte;
  7585. begin
  7586. result := inherited FlipVert;
  7587. if Assigned(Data) then begin
  7588. SourceData := Data;
  7589. GetMem(DestData, Height * fRowSize);
  7590. try
  7591. TempDestData := DestData;
  7592. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7593. for Row := 0 to Height -1 do begin
  7594. Move(SourceData^, TempDestData^, fRowSize);
  7595. Dec(TempDestData, fRowSize);
  7596. Inc(SourceData, fRowSize);
  7597. end;
  7598. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7599. result := true;
  7600. except
  7601. if Assigned(DestData) then
  7602. FreeMem(DestData);
  7603. raise;
  7604. end;
  7605. end;
  7606. end;
  7607. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7608. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7609. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7610. type
  7611. TMatrixItem = record
  7612. X, Y: Integer;
  7613. W: Single;
  7614. end;
  7615. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7616. TglBitmapToNormalMapRec = Record
  7617. Scale: Single;
  7618. Heights: array of Single;
  7619. MatrixU : array of TMatrixItem;
  7620. MatrixV : array of TMatrixItem;
  7621. end;
  7622. const
  7623. ONE_OVER_255 = 1 / 255;
  7624. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7625. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7626. var
  7627. Val: Single;
  7628. begin
  7629. with FuncRec do begin
  7630. Val :=
  7631. Source.Data.r * LUMINANCE_WEIGHT_R +
  7632. Source.Data.g * LUMINANCE_WEIGHT_G +
  7633. Source.Data.b * LUMINANCE_WEIGHT_B;
  7634. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7635. end;
  7636. end;
  7637. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7638. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7639. begin
  7640. with FuncRec do
  7641. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7642. end;
  7643. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7644. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7645. type
  7646. TVec = Array[0..2] of Single;
  7647. var
  7648. Idx: Integer;
  7649. du, dv: Double;
  7650. Len: Single;
  7651. Vec: TVec;
  7652. function GetHeight(X, Y: Integer): Single;
  7653. begin
  7654. with FuncRec do begin
  7655. X := Max(0, Min(Size.X -1, X));
  7656. Y := Max(0, Min(Size.Y -1, Y));
  7657. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7658. end;
  7659. end;
  7660. begin
  7661. with FuncRec do begin
  7662. with PglBitmapToNormalMapRec(Args)^ do begin
  7663. du := 0;
  7664. for Idx := Low(MatrixU) to High(MatrixU) do
  7665. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7666. dv := 0;
  7667. for Idx := Low(MatrixU) to High(MatrixU) do
  7668. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7669. Vec[0] := -du * Scale;
  7670. Vec[1] := -dv * Scale;
  7671. Vec[2] := 1;
  7672. end;
  7673. // Normalize
  7674. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7675. if Len <> 0 then begin
  7676. Vec[0] := Vec[0] * Len;
  7677. Vec[1] := Vec[1] * Len;
  7678. Vec[2] := Vec[2] * Len;
  7679. end;
  7680. // Farbe zuweisem
  7681. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7682. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7683. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7684. end;
  7685. end;
  7686. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7687. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7688. var
  7689. Rec: TglBitmapToNormalMapRec;
  7690. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7691. begin
  7692. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7693. Matrix[Index].X := X;
  7694. Matrix[Index].Y := Y;
  7695. Matrix[Index].W := W;
  7696. end;
  7697. end;
  7698. begin
  7699. if TFormatDescriptor.Get(Format).IsCompressed then
  7700. raise EglBitmapUnsupportedFormat.Create(Format);
  7701. if aScale > 100 then
  7702. Rec.Scale := 100
  7703. else if aScale < -100 then
  7704. Rec.Scale := -100
  7705. else
  7706. Rec.Scale := aScale;
  7707. SetLength(Rec.Heights, Width * Height);
  7708. try
  7709. case aFunc of
  7710. nm4Samples: begin
  7711. SetLength(Rec.MatrixU, 2);
  7712. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7713. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7714. SetLength(Rec.MatrixV, 2);
  7715. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7716. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7717. end;
  7718. nmSobel: begin
  7719. SetLength(Rec.MatrixU, 6);
  7720. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7721. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7722. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7723. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7724. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7725. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7726. SetLength(Rec.MatrixV, 6);
  7727. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7728. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7729. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7730. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7731. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7732. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7733. end;
  7734. nm3x3: begin
  7735. SetLength(Rec.MatrixU, 6);
  7736. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7737. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7738. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7739. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7740. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7741. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7742. SetLength(Rec.MatrixV, 6);
  7743. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7744. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7745. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7746. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7747. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7748. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7749. end;
  7750. nm5x5: begin
  7751. SetLength(Rec.MatrixU, 20);
  7752. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7753. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7754. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7755. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7756. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7757. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7758. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7759. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7760. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7761. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7762. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7763. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7764. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7765. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7766. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7767. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7768. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7769. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7770. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7771. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7772. SetLength(Rec.MatrixV, 20);
  7773. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7774. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7775. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7776. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7777. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7778. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7779. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7780. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7781. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7782. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7783. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7784. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7785. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7786. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7787. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7788. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7789. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7790. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7791. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7792. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7793. end;
  7794. end;
  7795. // Daten Sammeln
  7796. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7797. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7798. else
  7799. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7800. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7801. finally
  7802. SetLength(Rec.Heights, 0);
  7803. end;
  7804. end;
  7805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7806. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7807. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7808. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7809. begin
  7810. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7811. end;
  7812. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7813. procedure TglBitmapCubeMap.AfterConstruction;
  7814. begin
  7815. inherited;
  7816. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7817. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7818. SetWrap;
  7819. Target := GL_TEXTURE_CUBE_MAP;
  7820. fGenMode := GL_REFLECTION_MAP;
  7821. end;
  7822. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7823. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7824. var
  7825. BuildWithGlu: Boolean;
  7826. TexSize: Integer;
  7827. begin
  7828. if (aTestTextureSize) then begin
  7829. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7830. if (Height > TexSize) or (Width > TexSize) then
  7831. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7832. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7833. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7834. end;
  7835. if (ID = 0) then
  7836. CreateID;
  7837. SetupParameters(BuildWithGlu);
  7838. UploadData(aCubeTarget, BuildWithGlu);
  7839. end;
  7840. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7841. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
  7842. begin
  7843. inherited Bind (aEnableTextureUnit);
  7844. if aEnableTexCoordsGen then begin
  7845. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7846. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7847. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7848. glEnable(GL_TEXTURE_GEN_S);
  7849. glEnable(GL_TEXTURE_GEN_T);
  7850. glEnable(GL_TEXTURE_GEN_R);
  7851. end;
  7852. end;
  7853. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7854. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
  7855. begin
  7856. inherited Unbind(aDisableTextureUnit);
  7857. if aDisableTexCoordsGen then begin
  7858. glDisable(GL_TEXTURE_GEN_S);
  7859. glDisable(GL_TEXTURE_GEN_T);
  7860. glDisable(GL_TEXTURE_GEN_R);
  7861. end;
  7862. end;
  7863. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7864. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7865. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7866. type
  7867. TVec = Array[0..2] of Single;
  7868. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7869. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7870. TglBitmapNormalMapRec = record
  7871. HalfSize : Integer;
  7872. Func: TglBitmapNormalMapGetVectorFunc;
  7873. end;
  7874. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7875. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7876. begin
  7877. aVec[0] := aHalfSize;
  7878. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7879. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7880. end;
  7881. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7882. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7883. begin
  7884. aVec[0] := - aHalfSize;
  7885. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7886. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7887. end;
  7888. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7889. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7890. begin
  7891. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7892. aVec[1] := aHalfSize;
  7893. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7894. end;
  7895. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7896. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7897. begin
  7898. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7899. aVec[1] := - aHalfSize;
  7900. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7901. end;
  7902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7903. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7904. begin
  7905. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7906. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7907. aVec[2] := aHalfSize;
  7908. end;
  7909. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7910. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7911. begin
  7912. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7913. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7914. aVec[2] := - aHalfSize;
  7915. end;
  7916. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7917. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7918. var
  7919. i: Integer;
  7920. Vec: TVec;
  7921. Len: Single;
  7922. begin
  7923. with FuncRec do begin
  7924. with PglBitmapNormalMapRec(Args)^ do begin
  7925. Func(Vec, Position, HalfSize);
  7926. // Normalize
  7927. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7928. if Len <> 0 then begin
  7929. Vec[0] := Vec[0] * Len;
  7930. Vec[1] := Vec[1] * Len;
  7931. Vec[2] := Vec[2] * Len;
  7932. end;
  7933. // Scale Vector and AddVectro
  7934. Vec[0] := Vec[0] * 0.5 + 0.5;
  7935. Vec[1] := Vec[1] * 0.5 + 0.5;
  7936. Vec[2] := Vec[2] * 0.5 + 0.5;
  7937. end;
  7938. // Set Color
  7939. for i := 0 to 2 do
  7940. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7941. end;
  7942. end;
  7943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7944. procedure TglBitmapNormalMap.AfterConstruction;
  7945. begin
  7946. inherited;
  7947. fGenMode := GL_NORMAL_MAP;
  7948. end;
  7949. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7950. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7951. var
  7952. Rec: TglBitmapNormalMapRec;
  7953. SizeRec: TglBitmapPixelPosition;
  7954. begin
  7955. Rec.HalfSize := aSize div 2;
  7956. FreeDataAfterGenTexture := false;
  7957. SizeRec.Fields := [ffX, ffY];
  7958. SizeRec.X := aSize;
  7959. SizeRec.Y := aSize;
  7960. // Positive X
  7961. Rec.Func := glBitmapNormalMapPosX;
  7962. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7963. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7964. // Negative X
  7965. Rec.Func := glBitmapNormalMapNegX;
  7966. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7967. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7968. // Positive Y
  7969. Rec.Func := glBitmapNormalMapPosY;
  7970. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7971. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7972. // Negative Y
  7973. Rec.Func := glBitmapNormalMapNegY;
  7974. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7975. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7976. // Positive Z
  7977. Rec.Func := glBitmapNormalMapPosZ;
  7978. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7979. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7980. // Negative Z
  7981. Rec.Func := glBitmapNormalMapNegZ;
  7982. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7983. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7984. end;
  7985. initialization
  7986. glBitmapSetDefaultFormat (tfEmpty);
  7987. glBitmapSetDefaultMipmap (mmMipmap);
  7988. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7989. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7990. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7991. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7992. glBitmapSetDefaultDeleteTextureOnFree (true);
  7993. TFormatDescriptor.Init;
  7994. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7995. OpenGLInitialized := false;
  7996. InitOpenGLCS := TCriticalSection.Create;
  7997. {$ENDIF}
  7998. finalization
  7999. TFormatDescriptor.Finalize;
  8000. {$IFDEF GLB_NATIVE_OGL}
  8001. if Assigned(GL_LibHandle) then
  8002. glbFreeLibrary(GL_LibHandle);
  8003. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  8004. if Assigned(GLU_LibHandle) then
  8005. glbFreeLibrary(GLU_LibHandle);
  8006. FreeAndNil(InitOpenGLCS);
  8007. {$ENDIF}
  8008. {$ENDIF}
  8009. end.