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.

8667 regels
299 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. tfAlpha12,
  666. tfAlpha16,
  667. tfLuminance4,
  668. tfLuminance8,
  669. tfLuminance12,
  670. tfLuminance16,
  671. tfLuminance4Alpha4,
  672. tfLuminance6Alpha2,
  673. tfLuminance8Alpha8,
  674. tfLuminance12Alpha4,
  675. tfLuminance12Alpha12,
  676. tfLuminance16Alpha16,
  677. tfR3G3B2,
  678. tfRGB4,
  679. tfR5G6B5,
  680. tfRGB5,
  681. tfRGB8,
  682. tfRGB10,
  683. tfRGB12,
  684. tfRGB16,
  685. tfRGBA2,
  686. tfRGBA4,
  687. tfRGB5A1,
  688. tfRGBA8,
  689. tfRGB10A2,
  690. tfRGBA12,
  691. tfRGBA16,
  692. tfBGR4,
  693. tfB5G6R5,
  694. tfBGR5,
  695. tfBGR8,
  696. tfBGR10,
  697. tfBGR12,
  698. tfBGR16,
  699. tfBGRA2,
  700. tfBGRA4,
  701. tfBGR5A1,
  702. tfBGRA8,
  703. tfBGR10A2,
  704. tfBGRA12,
  705. tfBGRA16,
  706. tfDepth16,
  707. tfDepth24,
  708. tfDepth32,
  709. tfS3tcDtx1RGBA,
  710. tfS3tcDtx3RGBA,
  711. tfS3tcDtx5RGBA
  712. );
  713. TglBitmapFileType = (
  714. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  715. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  716. ftDDS,
  717. ftTGA,
  718. ftBMP);
  719. TglBitmapFileTypes = set of TglBitmapFileType;
  720. TglBitmapMipMap = (
  721. mmNone,
  722. mmMipmap,
  723. mmMipmapGlu);
  724. TglBitmapNormalMapFunc = (
  725. nm4Samples,
  726. nmSobel,
  727. nm3x3,
  728. nm5x5);
  729. ////////////////////////////////////////////////////////////////////////////////////////////////////
  730. EglBitmap = class(Exception);
  731. EglBitmapNotSupported = class(Exception);
  732. EglBitmapSizeToLarge = class(EglBitmap);
  733. EglBitmapNonPowerOfTwo = class(EglBitmap);
  734. EglBitmapUnsupportedFormat = class(EglBitmap)
  735. public
  736. constructor Create(const aFormat: TglBitmapFormat); overload;
  737. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  738. end;
  739. ////////////////////////////////////////////////////////////////////////////////////////////////////
  740. TglBitmapColorRec = packed record
  741. case Integer of
  742. 0: (r, g, b, a: Cardinal);
  743. 1: (arr: array[0..3] of Cardinal);
  744. end;
  745. TglBitmapPixelData = packed record
  746. Data, Range: TglBitmapColorRec;
  747. Format: TglBitmapFormat;
  748. end;
  749. PglBitmapPixelData = ^TglBitmapPixelData;
  750. ////////////////////////////////////////////////////////////////////////////////////////////////////
  751. TglBitmapPixelPositionFields = set of (ffX, ffY);
  752. TglBitmapPixelPosition = record
  753. Fields : TglBitmapPixelPositionFields;
  754. X : Word;
  755. Y : Word;
  756. end;
  757. TglBitmapFormatDescriptor = class(TObject)
  758. protected
  759. function GetIsCompressed: Boolean; virtual; abstract;
  760. function GetHasRed: Boolean; virtual; abstract;
  761. function GetHasGreen: Boolean; virtual; abstract;
  762. function GetHasBlue: Boolean; virtual; abstract;
  763. function GetHasAlpha: Boolean; virtual; abstract;
  764. function GetglDataFormat: GLenum; virtual; abstract;
  765. function GetglFormat: GLenum; virtual; abstract;
  766. function GetglInternalFormat: GLenum; virtual; abstract;
  767. public
  768. property IsCompressed: Boolean read GetIsCompressed;
  769. property HasRed: Boolean read GetHasRed;
  770. property HasGreen: Boolean read GetHasGreen;
  771. property HasBlue: Boolean read GetHasBlue;
  772. property HasAlpha: Boolean read GetHasAlpha;
  773. property glFormat: GLenum read GetglFormat;
  774. property glInternalFormat: GLenum read GetglInternalFormat;
  775. property glDataFormat: GLenum read GetglDataFormat;
  776. public
  777. class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  778. end;
  779. ////////////////////////////////////////////////////////////////////////////////////////////////////
  780. TglBitmap = class;
  781. TglBitmapFunctionRec = record
  782. Sender: TglBitmap;
  783. Size: TglBitmapPixelPosition;
  784. Position: TglBitmapPixelPosition;
  785. Source: TglBitmapPixelData;
  786. Dest: TglBitmapPixelData;
  787. Args: Pointer;
  788. end;
  789. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  790. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  791. TglBitmap = class
  792. private
  793. function GetFormatDesc: TglBitmapFormatDescriptor;
  794. protected
  795. fID: GLuint;
  796. fTarget: GLuint;
  797. fAnisotropic: Integer;
  798. fDeleteTextureOnFree: Boolean;
  799. fFreeDataOnDestroy: Boolean;
  800. fFreeDataAfterGenTexture: Boolean;
  801. fData: PByte;
  802. fIsResident: GLboolean;
  803. fBorderColor: array[0..3] of Single;
  804. fDimension: TglBitmapPixelPosition;
  805. fMipMap: TglBitmapMipMap;
  806. fFormat: TglBitmapFormat;
  807. // Mapping
  808. fPixelSize: Integer;
  809. fRowSize: Integer;
  810. // Filtering
  811. fFilterMin: GLenum;
  812. fFilterMag: GLenum;
  813. // TexturWarp
  814. fWrapS: GLenum;
  815. fWrapT: GLenum;
  816. fWrapR: GLenum;
  817. //Swizzle
  818. fSwizzle: array[0..3] of GLenum;
  819. // CustomData
  820. fFilename: String;
  821. fCustomName: String;
  822. fCustomNameW: WideString;
  823. fCustomData: Pointer;
  824. //Getter
  825. function GetWidth: Integer; virtual;
  826. function GetHeight: Integer; virtual;
  827. function GetFileWidth: Integer; virtual;
  828. function GetFileHeight: Integer; virtual;
  829. //Setter
  830. procedure SetCustomData(const aValue: Pointer);
  831. procedure SetCustomName(const aValue: String);
  832. procedure SetCustomNameW(const aValue: WideString);
  833. procedure SetFreeDataOnDestroy(const aValue: Boolean);
  834. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  835. procedure SetFormat(const aValue: TglBitmapFormat);
  836. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  837. procedure SetID(const aValue: Cardinal);
  838. procedure SetMipMap(const aValue: TglBitmapMipMap);
  839. procedure SetTarget(const aValue: Cardinal);
  840. procedure SetAnisotropic(const aValue: Integer);
  841. procedure CreateID;
  842. procedure SetupParameters(out aBuildWithGlu: Boolean);
  843. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  844. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method
  845. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  846. function FlipHorz: Boolean; virtual;
  847. function FlipVert: Boolean; virtual;
  848. property Width: Integer read GetWidth;
  849. property Height: Integer read GetHeight;
  850. property FileWidth: Integer read GetFileWidth;
  851. property FileHeight: Integer read GetFileHeight;
  852. public
  853. //Properties
  854. property ID: Cardinal read fID write SetID;
  855. property Target: Cardinal read fTarget write SetTarget;
  856. property Format: TglBitmapFormat read fFormat write SetFormat;
  857. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  858. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  859. property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc;
  860. property Filename: String read fFilename;
  861. property CustomName: String read fCustomName write SetCustomName;
  862. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  863. property CustomData: Pointer read fCustomData write SetCustomData;
  864. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  865. property FreeDataOnDestroy: Boolean read fFreeDataOnDestroy write SetFreeDataOnDestroy;
  866. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  867. property Dimension: TglBitmapPixelPosition read fDimension;
  868. property Data: PByte read fData;
  869. property IsResident: GLboolean read fIsResident;
  870. procedure AfterConstruction; override;
  871. procedure BeforeDestruction; override;
  872. procedure PrepareResType(var aResource: String; var aResType: PChar);
  873. //Load
  874. procedure LoadFromFile(const aFilename: String);
  875. procedure LoadFromStream(const aStream: TStream); virtual;
  876. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  877. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  878. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  879. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  880. //Save
  881. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  882. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  883. //Convert
  884. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  885. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  886. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  887. public
  888. //Alpha & Co
  889. {$IFDEF GLB_SDL}
  890. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  891. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  892. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  893. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  894. const aArgs: Pointer = nil): Boolean;
  895. {$ENDIF}
  896. {$IFDEF GLB_DELPHI}
  897. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  898. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  899. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  900. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  901. const aArgs: Pointer = nil): Boolean;
  902. {$ENDIF}
  903. {$IFDEF GLB_LAZARUS}
  904. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  905. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  906. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  907. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  908. const aArgs: Pointer = nil): Boolean;
  909. {$ENDIF}
  910. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  911. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  912. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  913. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  914. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  915. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  916. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  917. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  918. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  919. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  920. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  921. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  922. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  923. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  924. function RemoveAlpha: Boolean; virtual;
  925. public
  926. //Common
  927. function Clone: TglBitmap;
  928. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  929. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  930. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  931. procedure FreeData;
  932. //ColorFill
  933. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  934. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  935. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  936. //TexParameters
  937. procedure SetFilter(const aMin, aMag: GLenum);
  938. procedure SetWrap(
  939. const S: GLenum = GL_CLAMP_TO_EDGE;
  940. const T: GLenum = GL_CLAMP_TO_EDGE;
  941. const R: GLenum = GL_CLAMP_TO_EDGE);
  942. procedure SetSwizzle(const r, g, b, a: GLenum);
  943. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  944. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  945. //Constructors
  946. constructor Create; overload;
  947. constructor Create(const aFileName: String); overload;
  948. constructor Create(const aStream: TStream); overload;
  949. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  950. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  951. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  952. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  953. private
  954. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  955. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  956. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  957. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  958. function LoadBMP(const aStream: TStream): Boolean; virtual;
  959. procedure SaveBMP(const aStream: TStream); virtual;
  960. function LoadTGA(const aStream: TStream): Boolean; virtual;
  961. procedure SaveTGA(const aStream: TStream); virtual;
  962. function LoadDDS(const aStream: TStream): Boolean; virtual;
  963. procedure SaveDDS(const aStream: TStream); virtual;
  964. end;
  965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  966. TglBitmap1D = class(TglBitmap)
  967. protected
  968. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  969. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  970. procedure UploadData(const aBuildWithGlu: Boolean);
  971. public
  972. property Width;
  973. procedure AfterConstruction; override;
  974. function FlipHorz: Boolean; override;
  975. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  976. end;
  977. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  978. TglBitmap2D = class(TglBitmap)
  979. protected
  980. fLines: array of PByte;
  981. function GetScanline(const aIndex: Integer): Pointer;
  982. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  983. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  984. procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  985. public
  986. property Width;
  987. property Height;
  988. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  989. procedure AfterConstruction; override;
  990. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  991. procedure GetDataFromTexture;
  992. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  993. function FlipHorz: Boolean; override;
  994. function FlipVert: Boolean; override;
  995. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  996. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  997. end;
  998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  999. TglBitmapCubeMap = class(TglBitmap2D)
  1000. protected
  1001. fGenMode: Integer;
  1002. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  1003. public
  1004. procedure AfterConstruction; override;
  1005. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  1006. procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  1007. procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  1008. end;
  1009. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1010. TglBitmapNormalMap = class(TglBitmapCubeMap)
  1011. public
  1012. procedure AfterConstruction; override;
  1013. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  1014. end;
  1015. TglcBitmapFormat = TglBitmapFormat;
  1016. TglcBitmap1D = TglBitmap1D;
  1017. TglcBitmap2D = TglBitmap2D;
  1018. TglcBitmapCubeMap = TglBitmapCubeMap;
  1019. TglcBitmapNormalMap = TglBitmapNormalMap;
  1020. const
  1021. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1022. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1023. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1024. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1025. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1026. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1027. procedure glBitmapSetDefaultWrap(
  1028. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1029. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1030. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1031. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1032. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1033. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1034. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1035. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1036. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1037. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1038. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1039. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1040. var
  1041. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1042. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1043. glBitmapDefaultFormat: TglBitmapFormat;
  1044. glBitmapDefaultMipmap: TglBitmapMipMap;
  1045. glBitmapDefaultFilterMin: Cardinal;
  1046. glBitmapDefaultFilterMag: Cardinal;
  1047. glBitmapDefaultWrapS: Cardinal;
  1048. glBitmapDefaultWrapT: Cardinal;
  1049. glBitmapDefaultWrapR: Cardinal;
  1050. glDefaultSwizzle: array[0..3] of GLenum;
  1051. {$IFDEF GLB_DELPHI}
  1052. function CreateGrayPalette: HPALETTE;
  1053. {$ENDIF}
  1054. implementation
  1055. uses
  1056. Math, syncobjs, typinfo
  1057. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1058. type
  1059. {$IFNDEF fpc}
  1060. QWord = System.UInt64;
  1061. PQWord = ^QWord;
  1062. PtrInt = Longint;
  1063. PtrUInt = DWord;
  1064. {$ENDIF}
  1065. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1066. TShiftRec = packed record
  1067. case Integer of
  1068. 0: (r, g, b, a: Byte);
  1069. 1: (arr: array[0..3] of Byte);
  1070. end;
  1071. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1072. private
  1073. function GetRedMask: QWord;
  1074. function GetGreenMask: QWord;
  1075. function GetBlueMask: QWord;
  1076. function GetAlphaMask: QWord;
  1077. protected
  1078. fFormat: TglBitmapFormat;
  1079. fWithAlpha: TglBitmapFormat;
  1080. fWithoutAlpha: TglBitmapFormat;
  1081. fRGBInverted: TglBitmapFormat;
  1082. fUncompressed: TglBitmapFormat;
  1083. fPixelSize: Single;
  1084. fIsCompressed: Boolean;
  1085. fRange: TglBitmapColorRec;
  1086. fShift: TShiftRec;
  1087. fglFormat: GLenum;
  1088. fglInternalFormat: GLenum;
  1089. fglDataFormat: GLenum;
  1090. function GetIsCompressed: Boolean; override;
  1091. function GetHasRed: Boolean; override;
  1092. function GetHasGreen: Boolean; override;
  1093. function GetHasBlue: Boolean; override;
  1094. function GetHasAlpha: Boolean; override;
  1095. function GetglFormat: GLenum; override;
  1096. function GetglInternalFormat: GLenum; override;
  1097. function GetglDataFormat: GLenum; override;
  1098. function GetComponents: Integer; virtual;
  1099. public
  1100. property Format: TglBitmapFormat read fFormat;
  1101. property WithAlpha: TglBitmapFormat read fWithAlpha;
  1102. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  1103. property RGBInverted: TglBitmapFormat read fRGBInverted;
  1104. property Components: Integer read GetComponents;
  1105. property PixelSize: Single read fPixelSize;
  1106. property Range: TglBitmapColorRec read fRange;
  1107. property Shift: TShiftRec read fShift;
  1108. property RedMask: QWord read GetRedMask;
  1109. property GreenMask: QWord read GetGreenMask;
  1110. property BlueMask: QWord read GetBlueMask;
  1111. property AlphaMask: QWord read GetAlphaMask;
  1112. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1113. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1114. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1115. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1116. function CreateMappingData: Pointer; virtual;
  1117. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1118. function IsEmpty: Boolean; virtual;
  1119. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  1120. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1121. constructor Create; virtual;
  1122. public
  1123. class procedure Init;
  1124. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1125. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1126. class procedure Clear;
  1127. class procedure Finalize;
  1128. end;
  1129. TFormatDescriptorClass = class of TFormatDescriptor;
  1130. TfdEmpty = class(TFormatDescriptor);
  1131. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1132. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1133. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1134. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1135. constructor Create; override;
  1136. end;
  1137. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1138. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1139. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1140. constructor Create; override;
  1141. end;
  1142. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1143. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1144. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1145. constructor Create; override;
  1146. end;
  1147. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1148. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1149. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1150. constructor Create; override;
  1151. end;
  1152. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1153. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1154. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1155. constructor Create; override;
  1156. end;
  1157. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  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. constructor Create; override;
  1161. end;
  1162. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1163. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1164. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1165. constructor Create; override;
  1166. end;
  1167. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1168. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1169. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1170. constructor Create; override;
  1171. end;
  1172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1173. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  1174. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1175. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1176. constructor Create; 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. constructor Create; override;
  1182. end;
  1183. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1184. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1185. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1186. constructor Create; override;
  1187. end;
  1188. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1189. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1190. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1191. constructor Create; override;
  1192. end;
  1193. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1194. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1195. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1196. constructor Create; override;
  1197. end;
  1198. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1199. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1200. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1201. constructor Create; override;
  1202. end;
  1203. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1204. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1205. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1206. constructor Create; override;
  1207. end;
  1208. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1209. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1210. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1211. constructor Create; override;
  1212. end;
  1213. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1214. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1215. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1216. constructor Create; 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. constructor Create; override;
  1223. end;
  1224. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1225. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1226. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1227. constructor Create; override;
  1228. end;
  1229. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1230. TfdAlpha4 = class(TfdAlpha_UB1)
  1231. constructor Create; override;
  1232. end;
  1233. TfdAlpha8 = class(TfdAlpha_UB1)
  1234. constructor Create; override;
  1235. end;
  1236. TfdAlpha12 = class(TfdAlpha_US1)
  1237. constructor Create; override;
  1238. end;
  1239. TfdAlpha16 = class(TfdAlpha_US1)
  1240. constructor Create; override;
  1241. end;
  1242. TfdLuminance4 = class(TfdLuminance_UB1)
  1243. constructor Create; override;
  1244. end;
  1245. TfdLuminance8 = class(TfdLuminance_UB1)
  1246. constructor Create; override;
  1247. end;
  1248. TfdLuminance12 = class(TfdLuminance_US1)
  1249. constructor Create; override;
  1250. end;
  1251. TfdLuminance16 = class(TfdLuminance_US1)
  1252. constructor Create; override;
  1253. end;
  1254. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1255. constructor Create; override;
  1256. end;
  1257. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1258. constructor Create; override;
  1259. end;
  1260. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1261. constructor Create; override;
  1262. end;
  1263. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1264. constructor Create; override;
  1265. end;
  1266. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1267. constructor Create; override;
  1268. end;
  1269. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1270. constructor Create; override;
  1271. end;
  1272. TfdR3G3B2 = class(TfdUniversal_UB1)
  1273. constructor Create; override;
  1274. end;
  1275. TfdRGB4 = class(TfdUniversal_US1)
  1276. constructor Create; override;
  1277. end;
  1278. TfdR5G6B5 = class(TfdUniversal_US1)
  1279. constructor Create; override;
  1280. end;
  1281. TfdRGB5 = class(TfdUniversal_US1)
  1282. constructor Create; override;
  1283. end;
  1284. TfdRGB8 = class(TfdRGB_UB3)
  1285. constructor Create; override;
  1286. end;
  1287. TfdRGB10 = class(TfdUniversal_UI1)
  1288. constructor Create; override;
  1289. end;
  1290. TfdRGB12 = class(TfdRGB_US3)
  1291. constructor Create; override;
  1292. end;
  1293. TfdRGB16 = class(TfdRGB_US3)
  1294. constructor Create; override;
  1295. end;
  1296. TfdRGBA2 = class(TfdRGBA_UB4)
  1297. constructor Create; override;
  1298. end;
  1299. TfdRGBA4 = class(TfdUniversal_US1)
  1300. constructor Create; override;
  1301. end;
  1302. TfdRGB5A1 = class(TfdUniversal_US1)
  1303. constructor Create; override;
  1304. end;
  1305. TfdRGBA8 = class(TfdRGBA_UB4)
  1306. constructor Create; override;
  1307. end;
  1308. TfdRGB10A2 = class(TfdUniversal_UI1)
  1309. constructor Create; override;
  1310. end;
  1311. TfdRGBA12 = class(TfdRGBA_US4)
  1312. constructor Create; override;
  1313. end;
  1314. TfdRGBA16 = class(TfdRGBA_US4)
  1315. constructor Create; override;
  1316. end;
  1317. TfdBGR4 = class(TfdUniversal_US1)
  1318. constructor Create; override;
  1319. end;
  1320. TfdB5G6R5 = class(TfdUniversal_US1)
  1321. constructor Create; override;
  1322. end;
  1323. TfdBGR5 = class(TfdUniversal_US1)
  1324. constructor Create; override;
  1325. end;
  1326. TfdBGR8 = class(TfdBGR_UB3)
  1327. constructor Create; override;
  1328. end;
  1329. TfdBGR10 = class(TfdUniversal_UI1)
  1330. constructor Create; override;
  1331. end;
  1332. TfdBGR12 = class(TfdBGR_US3)
  1333. constructor Create; override;
  1334. end;
  1335. TfdBGR16 = class(TfdBGR_US3)
  1336. constructor Create; override;
  1337. end;
  1338. TfdBGRA2 = class(TfdBGRA_UB4)
  1339. constructor Create; override;
  1340. end;
  1341. TfdBGRA4 = class(TfdUniversal_US1)
  1342. constructor Create; override;
  1343. end;
  1344. TfdBGR5A1 = class(TfdUniversal_US1)
  1345. constructor Create; override;
  1346. end;
  1347. TfdBGRA8 = class(TfdBGRA_UB4)
  1348. constructor Create; override;
  1349. end;
  1350. TfdBGR10A2 = class(TfdUniversal_UI1)
  1351. constructor Create; override;
  1352. end;
  1353. TfdBGRA12 = class(TfdBGRA_US4)
  1354. constructor Create; override;
  1355. end;
  1356. TfdBGRA16 = class(TfdBGRA_US4)
  1357. constructor Create; override;
  1358. end;
  1359. TfdDepth16 = class(TfdDepth_US1)
  1360. constructor Create; override;
  1361. end;
  1362. TfdDepth24 = class(TfdDepth_UI1)
  1363. constructor Create; override;
  1364. end;
  1365. TfdDepth32 = class(TfdDepth_UI1)
  1366. constructor Create; override;
  1367. end;
  1368. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1369. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1370. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1371. constructor Create; override;
  1372. end;
  1373. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1374. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1375. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1376. constructor Create; override;
  1377. end;
  1378. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1379. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1380. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1381. constructor Create; override;
  1382. end;
  1383. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1384. TbmpBitfieldFormat = class(TFormatDescriptor)
  1385. private
  1386. procedure SetRedMask (const aValue: QWord);
  1387. procedure SetGreenMask(const aValue: QWord);
  1388. procedure SetBlueMask (const aValue: QWord);
  1389. procedure SetAlphaMask(const aValue: QWord);
  1390. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1391. public
  1392. property RedMask: QWord read GetRedMask write SetRedMask;
  1393. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1394. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1395. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1396. property PixelSize: Single read fPixelSize write fPixelSize;
  1397. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1398. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1399. end;
  1400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1401. TbmpColorTableEnty = packed record
  1402. b, g, r, a: Byte;
  1403. end;
  1404. TbmpColorTable = array of TbmpColorTableEnty;
  1405. TbmpColorTableFormat = class(TFormatDescriptor)
  1406. private
  1407. fColorTable: TbmpColorTable;
  1408. public
  1409. property PixelSize: Single read fPixelSize write fPixelSize;
  1410. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1411. property Range: TglBitmapColorRec read fRange write fRange;
  1412. property Shift: TShiftRec read fShift write fShift;
  1413. property Format: TglBitmapFormat read fFormat write fFormat;
  1414. procedure CreateColorTable;
  1415. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1416. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1417. destructor Destroy; override;
  1418. end;
  1419. const
  1420. LUMINANCE_WEIGHT_R = 0.30;
  1421. LUMINANCE_WEIGHT_G = 0.59;
  1422. LUMINANCE_WEIGHT_B = 0.11;
  1423. ALPHA_WEIGHT_R = 0.30;
  1424. ALPHA_WEIGHT_G = 0.59;
  1425. ALPHA_WEIGHT_B = 0.11;
  1426. DEPTH_WEIGHT_R = 0.333333333;
  1427. DEPTH_WEIGHT_G = 0.333333333;
  1428. DEPTH_WEIGHT_B = 0.333333333;
  1429. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1430. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1431. TfdEmpty,
  1432. TfdAlpha4,
  1433. TfdAlpha8,
  1434. TfdAlpha12,
  1435. TfdAlpha16,
  1436. TfdLuminance4,
  1437. TfdLuminance8,
  1438. TfdLuminance12,
  1439. TfdLuminance16,
  1440. TfdLuminance4Alpha4,
  1441. TfdLuminance6Alpha2,
  1442. TfdLuminance8Alpha8,
  1443. TfdLuminance12Alpha4,
  1444. TfdLuminance12Alpha12,
  1445. TfdLuminance16Alpha16,
  1446. TfdR3G3B2,
  1447. TfdRGB4,
  1448. TfdR5G6B5,
  1449. TfdRGB5,
  1450. TfdRGB8,
  1451. TfdRGB10,
  1452. TfdRGB12,
  1453. TfdRGB16,
  1454. TfdRGBA2,
  1455. TfdRGBA4,
  1456. TfdRGB5A1,
  1457. TfdRGBA8,
  1458. TfdRGB10A2,
  1459. TfdRGBA12,
  1460. TfdRGBA16,
  1461. TfdBGR4,
  1462. TfdB5G6R5,
  1463. TfdBGR5,
  1464. TfdBGR8,
  1465. TfdBGR10,
  1466. TfdBGR12,
  1467. TfdBGR16,
  1468. TfdBGRA2,
  1469. TfdBGRA4,
  1470. TfdBGR5A1,
  1471. TfdBGRA8,
  1472. TfdBGR10A2,
  1473. TfdBGRA12,
  1474. TfdBGRA16,
  1475. TfdDepth16,
  1476. TfdDepth24,
  1477. TfdDepth32,
  1478. TfdS3tcDtx1RGBA,
  1479. TfdS3tcDtx3RGBA,
  1480. TfdS3tcDtx5RGBA
  1481. );
  1482. var
  1483. FormatDescriptorCS: TCriticalSection;
  1484. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1485. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1486. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1487. begin
  1488. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1489. end;
  1490. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1491. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1492. begin
  1493. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1494. end;
  1495. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1496. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1497. begin
  1498. result.Fields := [];
  1499. if X >= 0 then
  1500. result.Fields := result.Fields + [ffX];
  1501. if Y >= 0 then
  1502. result.Fields := result.Fields + [ffY];
  1503. result.X := Max(0, X);
  1504. result.Y := Max(0, Y);
  1505. end;
  1506. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1507. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1508. begin
  1509. result.r := r;
  1510. result.g := g;
  1511. result.b := b;
  1512. result.a := a;
  1513. end;
  1514. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1515. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1516. var
  1517. i: Integer;
  1518. begin
  1519. result := false;
  1520. for i := 0 to high(r1.arr) do
  1521. if (r1.arr[i] <> r2.arr[i]) then
  1522. exit;
  1523. result := true;
  1524. end;
  1525. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1526. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1527. begin
  1528. result.r := r;
  1529. result.g := g;
  1530. result.b := b;
  1531. result.a := a;
  1532. end;
  1533. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1534. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1535. begin
  1536. result := [];
  1537. if (aFormat in [
  1538. //4 bbp
  1539. tfLuminance4,
  1540. //8bpp
  1541. tfR3G3B2, tfLuminance8,
  1542. //16bpp
  1543. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1544. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1545. //24bpp
  1546. tfBGR8, tfRGB8,
  1547. //32bpp
  1548. tfRGB10, tfRGB10A2, tfRGBA8,
  1549. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1550. result := result + [ftBMP];
  1551. if (aFormat in [
  1552. //8 bpp
  1553. tfLuminance8, tfAlpha8,
  1554. //16 bpp
  1555. tfLuminance16, tfLuminance8Alpha8,
  1556. tfRGB5, tfRGB5A1, tfRGBA4,
  1557. tfBGR5, tfBGR5A1, tfBGRA4,
  1558. //24 bpp
  1559. tfRGB8, tfBGR8,
  1560. //32 bpp
  1561. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1562. result := result + [ftTGA];
  1563. if (aFormat in [
  1564. //8 bpp
  1565. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1566. tfR3G3B2, tfRGBA2, tfBGRA2,
  1567. //16 bpp
  1568. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1569. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1570. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1571. //24 bpp
  1572. tfRGB8, tfBGR8,
  1573. //32 bbp
  1574. tfLuminance16Alpha16,
  1575. tfRGBA8, tfRGB10A2,
  1576. tfBGRA8, tfBGR10A2,
  1577. //compressed
  1578. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1579. result := result + [ftDDS];
  1580. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1581. if aFormat in [
  1582. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1583. tfRGB8, tfRGBA8,
  1584. tfBGR8, tfBGRA8] then
  1585. result := result + [ftPNG];
  1586. {$ENDIF}
  1587. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1588. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1589. result := result + [ftJPEG];
  1590. {$ENDIF}
  1591. end;
  1592. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1593. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1594. begin
  1595. while (aNumber and 1) = 0 do
  1596. aNumber := aNumber shr 1;
  1597. result := aNumber = 1;
  1598. end;
  1599. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1600. function GetTopMostBit(aBitSet: QWord): Integer;
  1601. begin
  1602. result := 0;
  1603. while aBitSet > 0 do begin
  1604. inc(result);
  1605. aBitSet := aBitSet shr 1;
  1606. end;
  1607. end;
  1608. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1609. function CountSetBits(aBitSet: QWord): Integer;
  1610. begin
  1611. result := 0;
  1612. while aBitSet > 0 do begin
  1613. if (aBitSet and 1) = 1 then
  1614. inc(result);
  1615. aBitSet := aBitSet shr 1;
  1616. end;
  1617. end;
  1618. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1619. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1620. begin
  1621. result := Trunc(
  1622. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1623. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1624. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1625. end;
  1626. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1627. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1628. begin
  1629. result := Trunc(
  1630. DEPTH_WEIGHT_R * aPixel.Data.r +
  1631. DEPTH_WEIGHT_G * aPixel.Data.g +
  1632. DEPTH_WEIGHT_B * aPixel.Data.b);
  1633. end;
  1634. {$IFDEF GLB_NATIVE_OGL}
  1635. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1636. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1637. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1638. var
  1639. GL_LibHandle: Pointer = nil;
  1640. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
  1641. begin
  1642. if not Assigned(aLibHandle) then
  1643. aLibHandle := GL_LibHandle;
  1644. {$IF DEFINED(GLB_WIN)}
  1645. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1646. if Assigned(result) then
  1647. exit;
  1648. if Assigned(wglGetProcAddress) then
  1649. result := wglGetProcAddress(aProcName);
  1650. {$ELSEIF DEFINED(GLB_LINUX)}
  1651. if Assigned(glXGetProcAddress) then begin
  1652. result := glXGetProcAddress(aProcName);
  1653. if Assigned(result) then
  1654. exit;
  1655. end;
  1656. if Assigned(glXGetProcAddressARB) then begin
  1657. result := glXGetProcAddressARB(aProcName);
  1658. if Assigned(result) then
  1659. exit;
  1660. end;
  1661. result := dlsym(aLibHandle, aProcName);
  1662. {$IFEND}
  1663. if not Assigned(result) and aRaiseOnErr then
  1664. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1665. end;
  1666. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1667. var
  1668. GLU_LibHandle: Pointer = nil;
  1669. OpenGLInitialized: Boolean;
  1670. InitOpenGLCS: TCriticalSection;
  1671. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1672. procedure glbInitOpenGL;
  1673. ////////////////////////////////////////////////////////////////////////////////
  1674. function glbLoadLibrary(const aName: PChar): Pointer;
  1675. begin
  1676. {$IF DEFINED(GLB_WIN)}
  1677. result := {%H-}Pointer(LoadLibrary(aName));
  1678. {$ELSEIF DEFINED(GLB_LINUX)}
  1679. result := dlopen(Name, RTLD_LAZY);
  1680. {$ELSE}
  1681. result := nil;
  1682. {$IFEND}
  1683. end;
  1684. ////////////////////////////////////////////////////////////////////////////////
  1685. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1686. begin
  1687. result := false;
  1688. if not Assigned(aLibHandle) then
  1689. exit;
  1690. {$IF DEFINED(GLB_WIN)}
  1691. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1692. {$ELSEIF DEFINED(GLB_LINUX)}
  1693. Result := dlclose(aLibHandle) = 0;
  1694. {$IFEND}
  1695. end;
  1696. begin
  1697. if Assigned(GL_LibHandle) then
  1698. glbFreeLibrary(GL_LibHandle);
  1699. if Assigned(GLU_LibHandle) then
  1700. glbFreeLibrary(GLU_LibHandle);
  1701. GL_LibHandle := glbLoadLibrary(libopengl);
  1702. if not Assigned(GL_LibHandle) then
  1703. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1704. GLU_LibHandle := glbLoadLibrary(libglu);
  1705. if not Assigned(GLU_LibHandle) then
  1706. raise EglBitmap.Create('unable to load library: ' + libglu);
  1707. {$IF DEFINED(GLB_WIN)}
  1708. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1709. {$ELSEIF DEFINED(GLB_LINUX)}
  1710. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1711. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1712. {$IFEND}
  1713. glEnable := glbGetProcAddress('glEnable');
  1714. glDisable := glbGetProcAddress('glDisable');
  1715. glGetString := glbGetProcAddress('glGetString');
  1716. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1717. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1718. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1719. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1720. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1721. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1722. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1723. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1724. glTexGeni := glbGetProcAddress('glTexGeni');
  1725. glGenTextures := glbGetProcAddress('glGenTextures');
  1726. glBindTexture := glbGetProcAddress('glBindTexture');
  1727. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1728. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1729. glReadPixels := glbGetProcAddress('glReadPixels');
  1730. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1731. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1732. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1733. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1734. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1735. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1736. end;
  1737. {$ENDIF}
  1738. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1739. procedure glbReadOpenGLExtensions;
  1740. var
  1741. Buffer: AnsiString;
  1742. MajorVersion, MinorVersion: Integer;
  1743. ///////////////////////////////////////////////////////////////////////////////////////////
  1744. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1745. var
  1746. Separator: Integer;
  1747. begin
  1748. aMinor := 0;
  1749. aMajor := 0;
  1750. Separator := Pos(AnsiString('.'), aBuffer);
  1751. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1752. (aBuffer[Separator - 1] in ['0'..'9']) and
  1753. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1754. Dec(Separator);
  1755. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1756. Dec(Separator);
  1757. Delete(aBuffer, 1, Separator);
  1758. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1759. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1760. Inc(Separator);
  1761. Delete(aBuffer, Separator, 255);
  1762. Separator := Pos(AnsiString('.'), aBuffer);
  1763. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1764. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1765. end;
  1766. end;
  1767. ///////////////////////////////////////////////////////////////////////////////////////////
  1768. function CheckExtension(const Extension: AnsiString): Boolean;
  1769. var
  1770. ExtPos: Integer;
  1771. begin
  1772. ExtPos := Pos(Extension, Buffer);
  1773. result := ExtPos > 0;
  1774. if result then
  1775. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1776. end;
  1777. ///////////////////////////////////////////////////////////////////////////////////////////
  1778. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1779. begin
  1780. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1781. end;
  1782. begin
  1783. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1784. InitOpenGLCS.Enter;
  1785. try
  1786. if not OpenGLInitialized then begin
  1787. glbInitOpenGL;
  1788. OpenGLInitialized := true;
  1789. end;
  1790. finally
  1791. InitOpenGLCS.Leave;
  1792. end;
  1793. {$ENDIF}
  1794. // Version
  1795. Buffer := glGetString(GL_VERSION);
  1796. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1797. GL_VERSION_1_2 := CheckVersion(1, 2);
  1798. GL_VERSION_1_3 := CheckVersion(1, 3);
  1799. GL_VERSION_1_4 := CheckVersion(1, 4);
  1800. GL_VERSION_2_0 := CheckVersion(2, 0);
  1801. GL_VERSION_3_3 := CheckVersion(3, 3);
  1802. // Extensions
  1803. Buffer := glGetString(GL_EXTENSIONS);
  1804. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1805. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1806. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1807. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1808. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1809. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1810. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1811. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1812. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1813. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1814. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1815. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1816. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1817. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1818. if GL_VERSION_1_3 then begin
  1819. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1820. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1821. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1822. end else begin
  1823. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false);
  1824. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false);
  1825. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
  1826. end;
  1827. end;
  1828. {$ENDIF}
  1829. {$IFDEF GLB_SDL_IMAGE}
  1830. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1831. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1832. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1833. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1834. begin
  1835. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1836. end;
  1837. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1838. begin
  1839. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1840. end;
  1841. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1842. begin
  1843. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1844. end;
  1845. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1846. begin
  1847. result := 0;
  1848. end;
  1849. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1850. begin
  1851. result := SDL_AllocRW;
  1852. if result = nil then
  1853. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1854. result^.seek := glBitmapRWseek;
  1855. result^.read := glBitmapRWread;
  1856. result^.write := glBitmapRWwrite;
  1857. result^.close := glBitmapRWclose;
  1858. result^.unknown.data1 := Stream;
  1859. end;
  1860. {$ENDIF}
  1861. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1862. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1863. begin
  1864. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1865. end;
  1866. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1867. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1868. begin
  1869. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1870. end;
  1871. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1872. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1873. begin
  1874. glBitmapDefaultMipmap := aValue;
  1875. end;
  1876. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1877. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1878. begin
  1879. glBitmapDefaultFormat := aFormat;
  1880. end;
  1881. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1882. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1883. begin
  1884. glBitmapDefaultFilterMin := aMin;
  1885. glBitmapDefaultFilterMag := aMag;
  1886. end;
  1887. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1888. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1889. begin
  1890. glBitmapDefaultWrapS := S;
  1891. glBitmapDefaultWrapT := T;
  1892. glBitmapDefaultWrapR := R;
  1893. end;
  1894. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1895. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1896. begin
  1897. glDefaultSwizzle[0] := r;
  1898. glDefaultSwizzle[1] := g;
  1899. glDefaultSwizzle[2] := b;
  1900. glDefaultSwizzle[3] := a;
  1901. end;
  1902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1903. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1904. begin
  1905. result := glBitmapDefaultDeleteTextureOnFree;
  1906. end;
  1907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1908. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1909. begin
  1910. result := glBitmapDefaultFreeDataAfterGenTextures;
  1911. end;
  1912. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1913. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1914. begin
  1915. result := glBitmapDefaultMipmap;
  1916. end;
  1917. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1918. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1919. begin
  1920. result := glBitmapDefaultFormat;
  1921. end;
  1922. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1923. procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
  1924. begin
  1925. aMin := glBitmapDefaultFilterMin;
  1926. aMag := glBitmapDefaultFilterMag;
  1927. end;
  1928. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1929. procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
  1930. begin
  1931. S := glBitmapDefaultWrapS;
  1932. T := glBitmapDefaultWrapT;
  1933. R := glBitmapDefaultWrapR;
  1934. end;
  1935. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1936. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1937. begin
  1938. r := glDefaultSwizzle[0];
  1939. g := glDefaultSwizzle[1];
  1940. b := glDefaultSwizzle[2];
  1941. a := glDefaultSwizzle[3];
  1942. end;
  1943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1944. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1945. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1946. function TFormatDescriptor.GetRedMask: QWord;
  1947. begin
  1948. result := fRange.r shl fShift.r;
  1949. end;
  1950. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1951. function TFormatDescriptor.GetGreenMask: QWord;
  1952. begin
  1953. result := fRange.g shl fShift.g;
  1954. end;
  1955. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1956. function TFormatDescriptor.GetBlueMask: QWord;
  1957. begin
  1958. result := fRange.b shl fShift.b;
  1959. end;
  1960. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1961. function TFormatDescriptor.GetAlphaMask: QWord;
  1962. begin
  1963. result := fRange.a shl fShift.a;
  1964. end;
  1965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1966. function TFormatDescriptor.GetIsCompressed: Boolean;
  1967. begin
  1968. result := fIsCompressed;
  1969. end;
  1970. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1971. function TFormatDescriptor.GetHasRed: Boolean;
  1972. begin
  1973. result := (fRange.r > 0);
  1974. end;
  1975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1976. function TFormatDescriptor.GetHasGreen: Boolean;
  1977. begin
  1978. result := (fRange.g > 0);
  1979. end;
  1980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1981. function TFormatDescriptor.GetHasBlue: Boolean;
  1982. begin
  1983. result := (fRange.b > 0);
  1984. end;
  1985. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1986. function TFormatDescriptor.GetHasAlpha: Boolean;
  1987. begin
  1988. result := (fRange.a > 0);
  1989. end;
  1990. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1991. function TFormatDescriptor.GetglFormat: GLenum;
  1992. begin
  1993. result := fglFormat;
  1994. end;
  1995. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1996. function TFormatDescriptor.GetglInternalFormat: GLenum;
  1997. begin
  1998. result := fglInternalFormat;
  1999. end;
  2000. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2001. function TFormatDescriptor.GetglDataFormat: GLenum;
  2002. begin
  2003. result := fglDataFormat;
  2004. end;
  2005. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2006. function TFormatDescriptor.GetComponents: Integer;
  2007. var
  2008. i: Integer;
  2009. begin
  2010. result := 0;
  2011. for i := 0 to 3 do
  2012. if (fRange.arr[i] > 0) then
  2013. inc(result);
  2014. end;
  2015. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2016. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  2017. var
  2018. w, h: Integer;
  2019. begin
  2020. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  2021. w := Max(1, aSize.X);
  2022. h := Max(1, aSize.Y);
  2023. result := GetSize(w, h);
  2024. end else
  2025. result := 0;
  2026. end;
  2027. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2028. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  2029. begin
  2030. result := 0;
  2031. if (aWidth <= 0) or (aHeight <= 0) then
  2032. exit;
  2033. result := Ceil(aWidth * aHeight * fPixelSize);
  2034. end;
  2035. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2036. function TFormatDescriptor.CreateMappingData: Pointer;
  2037. begin
  2038. result := nil;
  2039. end;
  2040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2041. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2042. begin
  2043. //DUMMY
  2044. end;
  2045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2046. function TFormatDescriptor.IsEmpty: Boolean;
  2047. begin
  2048. result := (fFormat = tfEmpty);
  2049. end;
  2050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2051. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  2052. begin
  2053. result := false;
  2054. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2055. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2056. if (aRedMask <> RedMask) then
  2057. exit;
  2058. if (aGreenMask <> GreenMask) then
  2059. exit;
  2060. if (aBlueMask <> BlueMask) then
  2061. exit;
  2062. if (aAlphaMask <> AlphaMask) then
  2063. exit;
  2064. result := true;
  2065. end;
  2066. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2067. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2068. begin
  2069. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2070. aPixel.Data := fRange;
  2071. aPixel.Range := fRange;
  2072. aPixel.Format := fFormat;
  2073. end;
  2074. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2075. constructor TFormatDescriptor.Create;
  2076. begin
  2077. inherited Create;
  2078. fFormat := tfEmpty;
  2079. fWithAlpha := tfEmpty;
  2080. fWithoutAlpha := tfEmpty;
  2081. fRGBInverted := tfEmpty;
  2082. fUncompressed := tfEmpty;
  2083. fPixelSize := 0.0;
  2084. fIsCompressed := false;
  2085. fglFormat := 0;
  2086. fglInternalFormat := 0;
  2087. fglDataFormat := 0;
  2088. FillChar(fRange, 0, SizeOf(fRange));
  2089. FillChar(fShift, 0, SizeOf(fShift));
  2090. end;
  2091. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2092. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2093. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2094. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2095. begin
  2096. aData^ := aPixel.Data.a;
  2097. inc(aData);
  2098. end;
  2099. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2100. begin
  2101. aPixel.Data.r := 0;
  2102. aPixel.Data.g := 0;
  2103. aPixel.Data.b := 0;
  2104. aPixel.Data.a := aData^;
  2105. inc(aData);
  2106. end;
  2107. constructor TfdAlpha_UB1.Create;
  2108. begin
  2109. inherited Create;
  2110. fPixelSize := 1.0;
  2111. fRange.a := $FF;
  2112. fglFormat := GL_ALPHA;
  2113. fglDataFormat := GL_UNSIGNED_BYTE;
  2114. end;
  2115. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2116. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2117. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2118. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2119. begin
  2120. aData^ := LuminanceWeight(aPixel);
  2121. inc(aData);
  2122. end;
  2123. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2124. begin
  2125. aPixel.Data.r := aData^;
  2126. aPixel.Data.g := aData^;
  2127. aPixel.Data.b := aData^;
  2128. aPixel.Data.a := 0;
  2129. inc(aData);
  2130. end;
  2131. constructor TfdLuminance_UB1.Create;
  2132. begin
  2133. inherited Create;
  2134. fPixelSize := 1.0;
  2135. fRange.r := $FF;
  2136. fRange.g := $FF;
  2137. fRange.b := $FF;
  2138. fglFormat := GL_LUMINANCE;
  2139. fglDataFormat := GL_UNSIGNED_BYTE;
  2140. end;
  2141. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2142. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2143. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2144. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2145. var
  2146. i: Integer;
  2147. begin
  2148. aData^ := 0;
  2149. for i := 0 to 3 do
  2150. if (fRange.arr[i] > 0) then
  2151. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2152. inc(aData);
  2153. end;
  2154. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2155. var
  2156. i: Integer;
  2157. begin
  2158. for i := 0 to 3 do
  2159. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2160. inc(aData);
  2161. end;
  2162. constructor TfdUniversal_UB1.Create;
  2163. begin
  2164. inherited Create;
  2165. fPixelSize := 1.0;
  2166. end;
  2167. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2168. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2169. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2170. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2171. begin
  2172. inherited Map(aPixel, aData, aMapData);
  2173. aData^ := aPixel.Data.a;
  2174. inc(aData);
  2175. end;
  2176. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2177. begin
  2178. inherited Unmap(aData, aPixel, aMapData);
  2179. aPixel.Data.a := aData^;
  2180. inc(aData);
  2181. end;
  2182. constructor TfdLuminanceAlpha_UB2.Create;
  2183. begin
  2184. inherited Create;
  2185. fPixelSize := 2.0;
  2186. fRange.a := $FF;
  2187. fShift.a := 8;
  2188. fglFormat := GL_LUMINANCE_ALPHA;
  2189. fglDataFormat := GL_UNSIGNED_BYTE;
  2190. end;
  2191. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2192. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2193. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2194. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2195. begin
  2196. aData^ := aPixel.Data.r;
  2197. inc(aData);
  2198. aData^ := aPixel.Data.g;
  2199. inc(aData);
  2200. aData^ := aPixel.Data.b;
  2201. inc(aData);
  2202. end;
  2203. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2204. begin
  2205. aPixel.Data.r := aData^;
  2206. inc(aData);
  2207. aPixel.Data.g := aData^;
  2208. inc(aData);
  2209. aPixel.Data.b := aData^;
  2210. inc(aData);
  2211. aPixel.Data.a := 0;
  2212. end;
  2213. constructor TfdRGB_UB3.Create;
  2214. begin
  2215. inherited Create;
  2216. fPixelSize := 3.0;
  2217. fRange.r := $FF;
  2218. fRange.g := $FF;
  2219. fRange.b := $FF;
  2220. fShift.r := 0;
  2221. fShift.g := 8;
  2222. fShift.b := 16;
  2223. fglFormat := GL_RGB;
  2224. fglDataFormat := GL_UNSIGNED_BYTE;
  2225. end;
  2226. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2227. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2229. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2230. begin
  2231. aData^ := aPixel.Data.b;
  2232. inc(aData);
  2233. aData^ := aPixel.Data.g;
  2234. inc(aData);
  2235. aData^ := aPixel.Data.r;
  2236. inc(aData);
  2237. end;
  2238. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2239. begin
  2240. aPixel.Data.b := aData^;
  2241. inc(aData);
  2242. aPixel.Data.g := aData^;
  2243. inc(aData);
  2244. aPixel.Data.r := aData^;
  2245. inc(aData);
  2246. aPixel.Data.a := 0;
  2247. end;
  2248. constructor TfdBGR_UB3.Create;
  2249. begin
  2250. fPixelSize := 3.0;
  2251. fRange.r := $FF;
  2252. fRange.g := $FF;
  2253. fRange.b := $FF;
  2254. fShift.r := 16;
  2255. fShift.g := 8;
  2256. fShift.b := 0;
  2257. fglFormat := GL_BGR;
  2258. fglDataFormat := GL_UNSIGNED_BYTE;
  2259. end;
  2260. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2261. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2262. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2263. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2264. begin
  2265. inherited Map(aPixel, aData, aMapData);
  2266. aData^ := aPixel.Data.a;
  2267. inc(aData);
  2268. end;
  2269. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2270. begin
  2271. inherited Unmap(aData, aPixel, aMapData);
  2272. aPixel.Data.a := aData^;
  2273. inc(aData);
  2274. end;
  2275. constructor TfdRGBA_UB4.Create;
  2276. begin
  2277. inherited Create;
  2278. fPixelSize := 4.0;
  2279. fRange.a := $FF;
  2280. fShift.a := 24;
  2281. fglFormat := GL_RGBA;
  2282. fglDataFormat := GL_UNSIGNED_BYTE;
  2283. end;
  2284. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2285. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2286. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2287. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2288. begin
  2289. inherited Map(aPixel, aData, aMapData);
  2290. aData^ := aPixel.Data.a;
  2291. inc(aData);
  2292. end;
  2293. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2294. begin
  2295. inherited Unmap(aData, aPixel, aMapData);
  2296. aPixel.Data.a := aData^;
  2297. inc(aData);
  2298. end;
  2299. constructor TfdBGRA_UB4.Create;
  2300. begin
  2301. inherited Create;
  2302. fPixelSize := 4.0;
  2303. fRange.a := $FF;
  2304. fShift.a := 24;
  2305. fglFormat := GL_BGRA;
  2306. fglDataFormat := GL_UNSIGNED_BYTE;
  2307. end;
  2308. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2309. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2310. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2311. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2312. begin
  2313. PWord(aData)^ := aPixel.Data.a;
  2314. inc(aData, 2);
  2315. end;
  2316. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2317. begin
  2318. aPixel.Data.r := 0;
  2319. aPixel.Data.g := 0;
  2320. aPixel.Data.b := 0;
  2321. aPixel.Data.a := PWord(aData)^;
  2322. inc(aData, 2);
  2323. end;
  2324. constructor TfdAlpha_US1.Create;
  2325. begin
  2326. inherited Create;
  2327. fPixelSize := 2.0;
  2328. fRange.a := $FFFF;
  2329. fglFormat := GL_ALPHA;
  2330. fglDataFormat := GL_UNSIGNED_SHORT;
  2331. end;
  2332. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2333. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2334. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2335. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2336. begin
  2337. PWord(aData)^ := LuminanceWeight(aPixel);
  2338. inc(aData, 2);
  2339. end;
  2340. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2341. begin
  2342. aPixel.Data.r := PWord(aData)^;
  2343. aPixel.Data.g := PWord(aData)^;
  2344. aPixel.Data.b := PWord(aData)^;
  2345. aPixel.Data.a := 0;
  2346. inc(aData, 2);
  2347. end;
  2348. constructor TfdLuminance_US1.Create;
  2349. begin
  2350. inherited Create;
  2351. fPixelSize := 2.0;
  2352. fRange.r := $FFFF;
  2353. fRange.g := $FFFF;
  2354. fRange.b := $FFFF;
  2355. fglFormat := GL_LUMINANCE;
  2356. fglDataFormat := GL_UNSIGNED_SHORT;
  2357. end;
  2358. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2359. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2360. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2361. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2362. var
  2363. i: Integer;
  2364. begin
  2365. PWord(aData)^ := 0;
  2366. for i := 0 to 3 do
  2367. if (fRange.arr[i] > 0) then
  2368. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2369. inc(aData, 2);
  2370. end;
  2371. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2372. var
  2373. i: Integer;
  2374. begin
  2375. for i := 0 to 3 do
  2376. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2377. inc(aData, 2);
  2378. end;
  2379. constructor TfdUniversal_US1.Create;
  2380. begin
  2381. inherited Create;
  2382. fPixelSize := 2.0;
  2383. end;
  2384. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2385. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2386. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2387. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2388. begin
  2389. PWord(aData)^ := DepthWeight(aPixel);
  2390. inc(aData, 2);
  2391. end;
  2392. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2393. begin
  2394. aPixel.Data.r := PWord(aData)^;
  2395. aPixel.Data.g := PWord(aData)^;
  2396. aPixel.Data.b := PWord(aData)^;
  2397. aPixel.Data.a := 0;
  2398. inc(aData, 2);
  2399. end;
  2400. constructor TfdDepth_US1.Create;
  2401. begin
  2402. inherited Create;
  2403. fPixelSize := 2.0;
  2404. fRange.r := $FFFF;
  2405. fRange.g := $FFFF;
  2406. fRange.b := $FFFF;
  2407. fglFormat := GL_DEPTH_COMPONENT;
  2408. fglDataFormat := GL_UNSIGNED_SHORT;
  2409. end;
  2410. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2411. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2412. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2413. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2414. begin
  2415. inherited Map(aPixel, aData, aMapData);
  2416. PWord(aData)^ := aPixel.Data.a;
  2417. inc(aData, 2);
  2418. end;
  2419. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2420. begin
  2421. inherited Unmap(aData, aPixel, aMapData);
  2422. aPixel.Data.a := PWord(aData)^;
  2423. inc(aData, 2);
  2424. end;
  2425. constructor TfdLuminanceAlpha_US2.Create;
  2426. begin
  2427. inherited Create;
  2428. fPixelSize := 4.0;
  2429. fRange.a := $FFFF;
  2430. fShift.a := 16;
  2431. fglFormat := GL_LUMINANCE_ALPHA;
  2432. fglDataFormat := GL_UNSIGNED_SHORT;
  2433. end;
  2434. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2435. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2436. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2437. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2438. begin
  2439. PWord(aData)^ := aPixel.Data.r;
  2440. inc(aData, 2);
  2441. PWord(aData)^ := aPixel.Data.g;
  2442. inc(aData, 2);
  2443. PWord(aData)^ := aPixel.Data.b;
  2444. inc(aData, 2);
  2445. end;
  2446. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2447. begin
  2448. aPixel.Data.r := PWord(aData)^;
  2449. inc(aData, 2);
  2450. aPixel.Data.g := PWord(aData)^;
  2451. inc(aData, 2);
  2452. aPixel.Data.b := PWord(aData)^;
  2453. inc(aData, 2);
  2454. aPixel.Data.a := 0;
  2455. end;
  2456. constructor TfdRGB_US3.Create;
  2457. begin
  2458. inherited Create;
  2459. fPixelSize := 6.0;
  2460. fRange.r := $FFFF;
  2461. fRange.g := $FFFF;
  2462. fRange.b := $FFFF;
  2463. fShift.r := 0;
  2464. fShift.g := 16;
  2465. fShift.b := 32;
  2466. fglFormat := GL_RGB;
  2467. fglDataFormat := GL_UNSIGNED_SHORT;
  2468. end;
  2469. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2470. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2471. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2472. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2473. begin
  2474. PWord(aData)^ := aPixel.Data.b;
  2475. inc(aData, 2);
  2476. PWord(aData)^ := aPixel.Data.g;
  2477. inc(aData, 2);
  2478. PWord(aData)^ := aPixel.Data.r;
  2479. inc(aData, 2);
  2480. end;
  2481. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2482. begin
  2483. aPixel.Data.b := PWord(aData)^;
  2484. inc(aData, 2);
  2485. aPixel.Data.g := PWord(aData)^;
  2486. inc(aData, 2);
  2487. aPixel.Data.r := PWord(aData)^;
  2488. inc(aData, 2);
  2489. aPixel.Data.a := 0;
  2490. end;
  2491. constructor TfdBGR_US3.Create;
  2492. begin
  2493. inherited Create;
  2494. fPixelSize := 6.0;
  2495. fRange.r := $FFFF;
  2496. fRange.g := $FFFF;
  2497. fRange.b := $FFFF;
  2498. fShift.r := 32;
  2499. fShift.g := 16;
  2500. fShift.b := 0;
  2501. fglFormat := GL_BGR;
  2502. fglDataFormat := GL_UNSIGNED_SHORT;
  2503. end;
  2504. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2505. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2506. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2507. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2508. begin
  2509. inherited Map(aPixel, aData, aMapData);
  2510. PWord(aData)^ := aPixel.Data.a;
  2511. inc(aData, 2);
  2512. end;
  2513. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2514. begin
  2515. inherited Unmap(aData, aPixel, aMapData);
  2516. aPixel.Data.a := PWord(aData)^;
  2517. inc(aData, 2);
  2518. end;
  2519. constructor TfdRGBA_US4.Create;
  2520. begin
  2521. inherited Create;
  2522. fPixelSize := 8.0;
  2523. fRange.a := $FFFF;
  2524. fShift.a := 48;
  2525. fglFormat := GL_RGBA;
  2526. fglDataFormat := GL_UNSIGNED_SHORT;
  2527. end;
  2528. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2529. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2530. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2531. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2532. begin
  2533. inherited Map(aPixel, aData, aMapData);
  2534. PWord(aData)^ := aPixel.Data.a;
  2535. inc(aData, 2);
  2536. end;
  2537. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2538. begin
  2539. inherited Unmap(aData, aPixel, aMapData);
  2540. aPixel.Data.a := PWord(aData)^;
  2541. inc(aData, 2);
  2542. end;
  2543. constructor TfdBGRA_US4.Create;
  2544. begin
  2545. inherited Create;
  2546. fPixelSize := 8.0;
  2547. fRange.a := $FFFF;
  2548. fShift.a := 48;
  2549. fglFormat := GL_BGRA;
  2550. fglDataFormat := GL_UNSIGNED_SHORT;
  2551. end;
  2552. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2553. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2554. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2555. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2556. var
  2557. i: Integer;
  2558. begin
  2559. PCardinal(aData)^ := 0;
  2560. for i := 0 to 3 do
  2561. if (fRange.arr[i] > 0) then
  2562. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2563. inc(aData, 4);
  2564. end;
  2565. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2566. var
  2567. i: Integer;
  2568. begin
  2569. for i := 0 to 3 do
  2570. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2571. inc(aData, 2);
  2572. end;
  2573. constructor TfdUniversal_UI1.Create;
  2574. begin
  2575. inherited Create;
  2576. fPixelSize := 4.0;
  2577. end;
  2578. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2579. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2580. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2581. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2582. begin
  2583. PCardinal(aData)^ := DepthWeight(aPixel);
  2584. inc(aData, 4);
  2585. end;
  2586. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2587. begin
  2588. aPixel.Data.r := PCardinal(aData)^;
  2589. aPixel.Data.g := PCardinal(aData)^;
  2590. aPixel.Data.b := PCardinal(aData)^;
  2591. aPixel.Data.a := 0;
  2592. inc(aData, 4);
  2593. end;
  2594. constructor TfdDepth_UI1.Create;
  2595. begin
  2596. inherited Create;
  2597. fPixelSize := 4.0;
  2598. fRange.r := $FFFFFFFF;
  2599. fRange.g := $FFFFFFFF;
  2600. fRange.b := $FFFFFFFF;
  2601. fglFormat := GL_DEPTH_COMPONENT;
  2602. fglDataFormat := GL_UNSIGNED_INT;
  2603. end;
  2604. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2605. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2606. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2607. constructor TfdAlpha4.Create;
  2608. begin
  2609. inherited Create;
  2610. fFormat := tfAlpha4;
  2611. fWithAlpha := tfAlpha4;
  2612. fglInternalFormat := GL_ALPHA4;
  2613. end;
  2614. constructor TfdAlpha8.Create;
  2615. begin
  2616. inherited Create;
  2617. fFormat := tfAlpha8;
  2618. fWithAlpha := tfAlpha8;
  2619. fglInternalFormat := GL_ALPHA8;
  2620. end;
  2621. constructor TfdAlpha12.Create;
  2622. begin
  2623. inherited Create;
  2624. fFormat := tfAlpha12;
  2625. fWithAlpha := tfAlpha12;
  2626. fglInternalFormat := GL_ALPHA12;
  2627. end;
  2628. constructor TfdAlpha16.Create;
  2629. begin
  2630. inherited Create;
  2631. fFormat := tfAlpha16;
  2632. fWithAlpha := tfAlpha16;
  2633. fglInternalFormat := GL_ALPHA16;
  2634. end;
  2635. constructor TfdLuminance4.Create;
  2636. begin
  2637. inherited Create;
  2638. fFormat := tfLuminance4;
  2639. fWithAlpha := tfLuminance4Alpha4;
  2640. fWithoutAlpha := tfLuminance4;
  2641. fglInternalFormat := GL_LUMINANCE4;
  2642. end;
  2643. constructor TfdLuminance8.Create;
  2644. begin
  2645. inherited Create;
  2646. fFormat := tfLuminance8;
  2647. fWithAlpha := tfLuminance8Alpha8;
  2648. fWithoutAlpha := tfLuminance8;
  2649. fglInternalFormat := GL_LUMINANCE8;
  2650. end;
  2651. constructor TfdLuminance12.Create;
  2652. begin
  2653. inherited Create;
  2654. fFormat := tfLuminance12;
  2655. fWithAlpha := tfLuminance12Alpha12;
  2656. fWithoutAlpha := tfLuminance12;
  2657. fglInternalFormat := GL_LUMINANCE12;
  2658. end;
  2659. constructor TfdLuminance16.Create;
  2660. begin
  2661. inherited Create;
  2662. fFormat := tfLuminance16;
  2663. fWithAlpha := tfLuminance16Alpha16;
  2664. fWithoutAlpha := tfLuminance16;
  2665. fglInternalFormat := GL_LUMINANCE16;
  2666. end;
  2667. constructor TfdLuminance4Alpha4.Create;
  2668. begin
  2669. inherited Create;
  2670. fFormat := tfLuminance4Alpha4;
  2671. fWithAlpha := tfLuminance4Alpha4;
  2672. fWithoutAlpha := tfLuminance4;
  2673. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2674. end;
  2675. constructor TfdLuminance6Alpha2.Create;
  2676. begin
  2677. inherited Create;
  2678. fFormat := tfLuminance6Alpha2;
  2679. fWithAlpha := tfLuminance6Alpha2;
  2680. fWithoutAlpha := tfLuminance8;
  2681. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2682. end;
  2683. constructor TfdLuminance8Alpha8.Create;
  2684. begin
  2685. inherited Create;
  2686. fFormat := tfLuminance8Alpha8;
  2687. fWithAlpha := tfLuminance8Alpha8;
  2688. fWithoutAlpha := tfLuminance8;
  2689. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2690. end;
  2691. constructor TfdLuminance12Alpha4.Create;
  2692. begin
  2693. inherited Create;
  2694. fFormat := tfLuminance12Alpha4;
  2695. fWithAlpha := tfLuminance12Alpha4;
  2696. fWithoutAlpha := tfLuminance12;
  2697. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2698. end;
  2699. constructor TfdLuminance12Alpha12.Create;
  2700. begin
  2701. inherited Create;
  2702. fFormat := tfLuminance12Alpha12;
  2703. fWithAlpha := tfLuminance12Alpha12;
  2704. fWithoutAlpha := tfLuminance12;
  2705. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2706. end;
  2707. constructor TfdLuminance16Alpha16.Create;
  2708. begin
  2709. inherited Create;
  2710. fFormat := tfLuminance16Alpha16;
  2711. fWithAlpha := tfLuminance16Alpha16;
  2712. fWithoutAlpha := tfLuminance16;
  2713. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2714. end;
  2715. constructor TfdR3G3B2.Create;
  2716. begin
  2717. inherited Create;
  2718. fFormat := tfR3G3B2;
  2719. fWithAlpha := tfRGBA2;
  2720. fWithoutAlpha := tfR3G3B2;
  2721. fRange.r := $7;
  2722. fRange.g := $7;
  2723. fRange.b := $3;
  2724. fShift.r := 0;
  2725. fShift.g := 3;
  2726. fShift.b := 6;
  2727. fglFormat := GL_RGB;
  2728. fglInternalFormat := GL_R3_G3_B2;
  2729. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2730. end;
  2731. constructor TfdRGB4.Create;
  2732. begin
  2733. inherited Create;
  2734. fFormat := tfRGB4;
  2735. fWithAlpha := tfRGBA4;
  2736. fWithoutAlpha := tfRGB4;
  2737. fRGBInverted := tfBGR4;
  2738. fRange.r := $F;
  2739. fRange.g := $F;
  2740. fRange.b := $F;
  2741. fShift.r := 0;
  2742. fShift.g := 4;
  2743. fShift.b := 8;
  2744. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2745. fglInternalFormat := GL_RGB4;
  2746. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2747. end;
  2748. constructor TfdR5G6B5.Create;
  2749. begin
  2750. inherited Create;
  2751. fFormat := tfR5G6B5;
  2752. fWithAlpha := tfRGBA4;
  2753. fWithoutAlpha := tfR5G6B5;
  2754. fRGBInverted := tfB5G6R5;
  2755. fRange.r := $1F;
  2756. fRange.g := $3F;
  2757. fRange.b := $1F;
  2758. fShift.r := 0;
  2759. fShift.g := 5;
  2760. fShift.b := 11;
  2761. fglFormat := GL_RGB;
  2762. fglInternalFormat := GL_RGB565;
  2763. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2764. end;
  2765. constructor TfdRGB5.Create;
  2766. begin
  2767. inherited Create;
  2768. fFormat := tfRGB5;
  2769. fWithAlpha := tfRGB5A1;
  2770. fWithoutAlpha := tfRGB5;
  2771. fRGBInverted := tfBGR5;
  2772. fRange.r := $1F;
  2773. fRange.g := $1F;
  2774. fRange.b := $1F;
  2775. fShift.r := 0;
  2776. fShift.g := 5;
  2777. fShift.b := 10;
  2778. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2779. fglInternalFormat := GL_RGB5;
  2780. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2781. end;
  2782. constructor TfdRGB8.Create;
  2783. begin
  2784. inherited Create;
  2785. fFormat := tfRGB8;
  2786. fWithAlpha := tfRGBA8;
  2787. fWithoutAlpha := tfRGB8;
  2788. fRGBInverted := tfBGR8;
  2789. fglInternalFormat := GL_RGB8;
  2790. end;
  2791. constructor TfdRGB10.Create;
  2792. begin
  2793. inherited Create;
  2794. fFormat := tfRGB10;
  2795. fWithAlpha := tfRGB10A2;
  2796. fWithoutAlpha := tfRGB10;
  2797. fRGBInverted := tfBGR10;
  2798. fRange.r := $3FF;
  2799. fRange.g := $3FF;
  2800. fRange.b := $3FF;
  2801. fShift.r := 0;
  2802. fShift.g := 10;
  2803. fShift.b := 20;
  2804. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2805. fglInternalFormat := GL_RGB10;
  2806. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2807. end;
  2808. constructor TfdRGB12.Create;
  2809. begin
  2810. inherited Create;
  2811. fFormat := tfRGB12;
  2812. fWithAlpha := tfRGBA12;
  2813. fWithoutAlpha := tfRGB12;
  2814. fRGBInverted := tfBGR12;
  2815. fglInternalFormat := GL_RGB12;
  2816. end;
  2817. constructor TfdRGB16.Create;
  2818. begin
  2819. inherited Create;
  2820. fFormat := tfRGB16;
  2821. fWithAlpha := tfRGBA16;
  2822. fWithoutAlpha := tfRGB16;
  2823. fRGBInverted := tfBGR16;
  2824. fglInternalFormat := GL_RGB16;
  2825. end;
  2826. constructor TfdRGBA2.Create;
  2827. begin
  2828. inherited Create;
  2829. fFormat := tfRGBA2;
  2830. fWithAlpha := tfRGBA2;
  2831. fWithoutAlpha := tfR3G3B2;
  2832. fRGBInverted := tfBGRA2;
  2833. fglInternalFormat := GL_RGBA2;
  2834. end;
  2835. constructor TfdRGBA4.Create;
  2836. begin
  2837. inherited Create;
  2838. fFormat := tfRGBA4;
  2839. fWithAlpha := tfRGBA4;
  2840. fWithoutAlpha := tfRGB4;
  2841. fRGBInverted := tfBGRA4;
  2842. fRange.r := $F;
  2843. fRange.g := $F;
  2844. fRange.b := $F;
  2845. fRange.a := $F;
  2846. fShift.r := 0;
  2847. fShift.g := 4;
  2848. fShift.b := 8;
  2849. fShift.a := 12;
  2850. fglFormat := GL_RGBA;
  2851. fglInternalFormat := GL_RGBA4;
  2852. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2853. end;
  2854. constructor TfdRGB5A1.Create;
  2855. begin
  2856. inherited Create;
  2857. fFormat := tfRGB5A1;
  2858. fWithAlpha := tfRGB5A1;
  2859. fWithoutAlpha := tfRGB5;
  2860. fRGBInverted := tfBGR5A1;
  2861. fRange.r := $1F;
  2862. fRange.g := $1F;
  2863. fRange.b := $1F;
  2864. fRange.a := $01;
  2865. fShift.r := 0;
  2866. fShift.g := 5;
  2867. fShift.b := 10;
  2868. fShift.a := 15;
  2869. fglFormat := GL_RGBA;
  2870. fglInternalFormat := GL_RGB5_A1;
  2871. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2872. end;
  2873. constructor TfdRGBA8.Create;
  2874. begin
  2875. inherited Create;
  2876. fFormat := tfRGBA8;
  2877. fWithAlpha := tfRGBA8;
  2878. fWithoutAlpha := tfRGB8;
  2879. fRGBInverted := tfBGRA8;
  2880. fglInternalFormat := GL_RGBA8;
  2881. end;
  2882. constructor TfdRGB10A2.Create;
  2883. begin
  2884. inherited Create;
  2885. fFormat := tfRGB10A2;
  2886. fWithAlpha := tfRGB10A2;
  2887. fWithoutAlpha := tfRGB10;
  2888. fRGBInverted := tfBGR10A2;
  2889. fRange.r := $3FF;
  2890. fRange.g := $3FF;
  2891. fRange.b := $3FF;
  2892. fRange.a := $003;
  2893. fShift.r := 0;
  2894. fShift.g := 10;
  2895. fShift.b := 20;
  2896. fShift.a := 30;
  2897. fglFormat := GL_RGBA;
  2898. fglInternalFormat := GL_RGB10_A2;
  2899. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2900. end;
  2901. constructor TfdRGBA12.Create;
  2902. begin
  2903. inherited Create;
  2904. fFormat := tfRGBA12;
  2905. fWithAlpha := tfRGBA12;
  2906. fWithoutAlpha := tfRGB12;
  2907. fRGBInverted := tfBGRA12;
  2908. fglInternalFormat := GL_RGBA12;
  2909. end;
  2910. constructor TfdRGBA16.Create;
  2911. begin
  2912. inherited Create;
  2913. fFormat := tfRGBA16;
  2914. fWithAlpha := tfRGBA16;
  2915. fWithoutAlpha := tfRGB16;
  2916. fRGBInverted := tfBGRA16;
  2917. fglInternalFormat := GL_RGBA16;
  2918. end;
  2919. constructor TfdBGR4.Create;
  2920. begin
  2921. inherited Create;
  2922. fPixelSize := 2.0;
  2923. fFormat := tfBGR4;
  2924. fWithAlpha := tfBGRA4;
  2925. fWithoutAlpha := tfBGR4;
  2926. fRGBInverted := tfRGB4;
  2927. fRange.r := $F;
  2928. fRange.g := $F;
  2929. fRange.b := $F;
  2930. fRange.a := $0;
  2931. fShift.r := 8;
  2932. fShift.g := 4;
  2933. fShift.b := 0;
  2934. fShift.a := 0;
  2935. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2936. fglInternalFormat := GL_RGB4;
  2937. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2938. end;
  2939. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2940. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2941. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2942. constructor TfdB5G6R5.Create;
  2943. begin
  2944. inherited Create;
  2945. fFormat := tfB5G6R5;
  2946. fWithAlpha := tfBGRA4;
  2947. fWithoutAlpha := tfB5G6R5;
  2948. fRGBInverted := tfR5G6B5;
  2949. fRange.r := $1F;
  2950. fRange.g := $3F;
  2951. fRange.b := $1F;
  2952. fShift.r := 11;
  2953. fShift.g := 5;
  2954. fShift.b := 0;
  2955. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2956. fglInternalFormat := GL_RGB8;
  2957. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2958. end;
  2959. constructor TfdBGR5.Create;
  2960. begin
  2961. inherited Create;
  2962. fPixelSize := 2.0;
  2963. fFormat := tfBGR5;
  2964. fWithAlpha := tfBGR5A1;
  2965. fWithoutAlpha := tfBGR5;
  2966. fRGBInverted := tfRGB5;
  2967. fRange.r := $1F;
  2968. fRange.g := $1F;
  2969. fRange.b := $1F;
  2970. fRange.a := $00;
  2971. fShift.r := 10;
  2972. fShift.g := 5;
  2973. fShift.b := 0;
  2974. fShift.a := 0;
  2975. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2976. fglInternalFormat := GL_RGB5;
  2977. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2978. end;
  2979. constructor TfdBGR8.Create;
  2980. begin
  2981. inherited Create;
  2982. fFormat := tfBGR8;
  2983. fWithAlpha := tfBGRA8;
  2984. fWithoutAlpha := tfBGR8;
  2985. fRGBInverted := tfRGB8;
  2986. fglInternalFormat := GL_RGB8;
  2987. end;
  2988. constructor TfdBGR10.Create;
  2989. begin
  2990. inherited Create;
  2991. fFormat := tfBGR10;
  2992. fWithAlpha := tfBGR10A2;
  2993. fWithoutAlpha := tfBGR10;
  2994. fRGBInverted := tfRGB10;
  2995. fRange.r := $3FF;
  2996. fRange.g := $3FF;
  2997. fRange.b := $3FF;
  2998. fRange.a := $000;
  2999. fShift.r := 20;
  3000. fShift.g := 10;
  3001. fShift.b := 0;
  3002. fShift.a := 0;
  3003. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3004. fglInternalFormat := GL_RGB10;
  3005. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3006. end;
  3007. constructor TfdBGR12.Create;
  3008. begin
  3009. inherited Create;
  3010. fFormat := tfBGR12;
  3011. fWithAlpha := tfBGRA12;
  3012. fWithoutAlpha := tfBGR12;
  3013. fRGBInverted := tfRGB12;
  3014. fglInternalFormat := GL_RGB12;
  3015. end;
  3016. constructor TfdBGR16.Create;
  3017. begin
  3018. inherited Create;
  3019. fFormat := tfBGR16;
  3020. fWithAlpha := tfBGRA16;
  3021. fWithoutAlpha := tfBGR16;
  3022. fRGBInverted := tfRGB16;
  3023. fglInternalFormat := GL_RGB16;
  3024. end;
  3025. constructor TfdBGRA2.Create;
  3026. begin
  3027. inherited Create;
  3028. fFormat := tfBGRA2;
  3029. fWithAlpha := tfBGRA4;
  3030. fWithoutAlpha := tfBGR4;
  3031. fRGBInverted := tfRGBA2;
  3032. fglInternalFormat := GL_RGBA2;
  3033. end;
  3034. constructor TfdBGRA4.Create;
  3035. begin
  3036. inherited Create;
  3037. fFormat := tfBGRA4;
  3038. fWithAlpha := tfBGRA4;
  3039. fWithoutAlpha := tfBGR4;
  3040. fRGBInverted := tfRGBA4;
  3041. fRange.r := $F;
  3042. fRange.g := $F;
  3043. fRange.b := $F;
  3044. fRange.a := $F;
  3045. fShift.r := 8;
  3046. fShift.g := 4;
  3047. fShift.b := 0;
  3048. fShift.a := 12;
  3049. fglFormat := GL_BGRA;
  3050. fglInternalFormat := GL_RGBA4;
  3051. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3052. end;
  3053. constructor TfdBGR5A1.Create;
  3054. begin
  3055. inherited Create;
  3056. fFormat := tfBGR5A1;
  3057. fWithAlpha := tfBGR5A1;
  3058. fWithoutAlpha := tfBGR5;
  3059. fRGBInverted := tfRGB5A1;
  3060. fRange.r := $1F;
  3061. fRange.g := $1F;
  3062. fRange.b := $1F;
  3063. fRange.a := $01;
  3064. fShift.r := 10;
  3065. fShift.g := 5;
  3066. fShift.b := 0;
  3067. fShift.a := 15;
  3068. fglFormat := GL_BGRA;
  3069. fglInternalFormat := GL_RGB5_A1;
  3070. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3071. end;
  3072. constructor TfdBGRA8.Create;
  3073. begin
  3074. inherited Create;
  3075. fFormat := tfBGRA8;
  3076. fWithAlpha := tfBGRA8;
  3077. fWithoutAlpha := tfBGR8;
  3078. fRGBInverted := tfRGBA8;
  3079. fglInternalFormat := GL_RGBA8;
  3080. end;
  3081. constructor TfdBGR10A2.Create;
  3082. begin
  3083. inherited Create;
  3084. fFormat := tfBGR10A2;
  3085. fWithAlpha := tfBGR10A2;
  3086. fWithoutAlpha := tfBGR10;
  3087. fRGBInverted := tfRGB10A2;
  3088. fRange.r := $3FF;
  3089. fRange.g := $3FF;
  3090. fRange.b := $3FF;
  3091. fRange.a := $003;
  3092. fShift.r := 20;
  3093. fShift.g := 10;
  3094. fShift.b := 0;
  3095. fShift.a := 30;
  3096. fglFormat := GL_BGRA;
  3097. fglInternalFormat := GL_RGB10_A2;
  3098. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3099. end;
  3100. constructor TfdBGRA12.Create;
  3101. begin
  3102. inherited Create;
  3103. fFormat := tfBGRA12;
  3104. fWithAlpha := tfBGRA12;
  3105. fWithoutAlpha := tfBGR12;
  3106. fRGBInverted := tfRGBA12;
  3107. fglInternalFormat := GL_RGBA12;
  3108. end;
  3109. constructor TfdBGRA16.Create;
  3110. begin
  3111. inherited Create;
  3112. fFormat := tfBGRA16;
  3113. fWithAlpha := tfBGRA16;
  3114. fWithoutAlpha := tfBGR16;
  3115. fRGBInverted := tfRGBA16;
  3116. fglInternalFormat := GL_RGBA16;
  3117. end;
  3118. constructor TfdDepth16.Create;
  3119. begin
  3120. inherited Create;
  3121. fFormat := tfDepth16;
  3122. fWithAlpha := tfEmpty;
  3123. fWithoutAlpha := tfDepth16;
  3124. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3125. end;
  3126. constructor TfdDepth24.Create;
  3127. begin
  3128. inherited Create;
  3129. fFormat := tfDepth24;
  3130. fWithAlpha := tfEmpty;
  3131. fWithoutAlpha := tfDepth24;
  3132. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3133. end;
  3134. constructor TfdDepth32.Create;
  3135. begin
  3136. inherited Create;
  3137. fFormat := tfDepth32;
  3138. fWithAlpha := tfEmpty;
  3139. fWithoutAlpha := tfDepth32;
  3140. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3141. end;
  3142. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3143. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3144. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3145. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3146. begin
  3147. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3148. end;
  3149. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3150. begin
  3151. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3152. end;
  3153. constructor TfdS3tcDtx1RGBA.Create;
  3154. begin
  3155. inherited Create;
  3156. fFormat := tfS3tcDtx1RGBA;
  3157. fWithAlpha := tfS3tcDtx1RGBA;
  3158. fUncompressed := tfRGB5A1;
  3159. fPixelSize := 0.5;
  3160. fIsCompressed := true;
  3161. fglFormat := GL_COMPRESSED_RGBA;
  3162. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3163. fglDataFormat := GL_UNSIGNED_BYTE;
  3164. end;
  3165. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3166. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3167. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3168. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3169. begin
  3170. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3171. end;
  3172. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3173. begin
  3174. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3175. end;
  3176. constructor TfdS3tcDtx3RGBA.Create;
  3177. begin
  3178. inherited Create;
  3179. fFormat := tfS3tcDtx3RGBA;
  3180. fWithAlpha := tfS3tcDtx3RGBA;
  3181. fUncompressed := tfRGBA8;
  3182. fPixelSize := 1.0;
  3183. fIsCompressed := true;
  3184. fglFormat := GL_COMPRESSED_RGBA;
  3185. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3186. fglDataFormat := GL_UNSIGNED_BYTE;
  3187. end;
  3188. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3189. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3190. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3191. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3192. begin
  3193. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3194. end;
  3195. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3196. begin
  3197. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3198. end;
  3199. constructor TfdS3tcDtx5RGBA.Create;
  3200. begin
  3201. inherited Create;
  3202. fFormat := tfS3tcDtx3RGBA;
  3203. fWithAlpha := tfS3tcDtx3RGBA;
  3204. fUncompressed := tfRGBA8;
  3205. fPixelSize := 1.0;
  3206. fIsCompressed := true;
  3207. fglFormat := GL_COMPRESSED_RGBA;
  3208. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3209. fglDataFormat := GL_UNSIGNED_BYTE;
  3210. end;
  3211. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3212. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3213. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3214. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3215. var
  3216. f: TglBitmapFormat;
  3217. begin
  3218. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3219. result := TFormatDescriptor.Get(f);
  3220. if (result.glInternalFormat = aInternalFormat) then
  3221. exit;
  3222. end;
  3223. result := TFormatDescriptor.Get(tfEmpty);
  3224. end;
  3225. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3226. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3227. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3228. class procedure TFormatDescriptor.Init;
  3229. begin
  3230. if not Assigned(FormatDescriptorCS) then
  3231. FormatDescriptorCS := TCriticalSection.Create;
  3232. end;
  3233. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3234. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3235. begin
  3236. FormatDescriptorCS.Enter;
  3237. try
  3238. result := FormatDescriptors[aFormat];
  3239. if not Assigned(result) then begin
  3240. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3241. FormatDescriptors[aFormat] := result;
  3242. end;
  3243. finally
  3244. FormatDescriptorCS.Leave;
  3245. end;
  3246. end;
  3247. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3248. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3249. begin
  3250. result := Get(Get(aFormat).WithAlpha);
  3251. end;
  3252. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3253. class procedure TFormatDescriptor.Clear;
  3254. var
  3255. f: TglBitmapFormat;
  3256. begin
  3257. FormatDescriptorCS.Enter;
  3258. try
  3259. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3260. FreeAndNil(FormatDescriptors[f]);
  3261. finally
  3262. FormatDescriptorCS.Leave;
  3263. end;
  3264. end;
  3265. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3266. class procedure TFormatDescriptor.Finalize;
  3267. begin
  3268. Clear;
  3269. FreeAndNil(FormatDescriptorCS);
  3270. end;
  3271. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3272. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3273. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3274. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3275. begin
  3276. Update(aValue, fRange.r, fShift.r);
  3277. end;
  3278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3279. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3280. begin
  3281. Update(aValue, fRange.g, fShift.g);
  3282. end;
  3283. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3284. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3285. begin
  3286. Update(aValue, fRange.b, fShift.b);
  3287. end;
  3288. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3289. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3290. begin
  3291. Update(aValue, fRange.a, fShift.a);
  3292. end;
  3293. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3294. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3295. aShift: Byte);
  3296. begin
  3297. aShift := 0;
  3298. aRange := 0;
  3299. if (aMask = 0) then
  3300. exit;
  3301. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3302. inc(aShift);
  3303. aMask := aMask shr 1;
  3304. end;
  3305. aRange := 1;
  3306. while (aMask > 0) do begin
  3307. aRange := aRange shl 1;
  3308. aMask := aMask shr 1;
  3309. end;
  3310. dec(aRange);
  3311. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3312. end;
  3313. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3314. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3315. var
  3316. data: QWord;
  3317. s: Integer;
  3318. begin
  3319. data :=
  3320. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3321. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3322. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3323. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3324. s := Round(fPixelSize);
  3325. case s of
  3326. 1: aData^ := data;
  3327. 2: PWord(aData)^ := data;
  3328. 4: PCardinal(aData)^ := data;
  3329. 8: PQWord(aData)^ := data;
  3330. else
  3331. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3332. end;
  3333. inc(aData, s);
  3334. end;
  3335. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3336. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3337. var
  3338. data: QWord;
  3339. s, i: Integer;
  3340. begin
  3341. s := Round(fPixelSize);
  3342. case s of
  3343. 1: data := aData^;
  3344. 2: data := PWord(aData)^;
  3345. 4: data := PCardinal(aData)^;
  3346. 8: data := PQWord(aData)^;
  3347. else
  3348. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3349. end;
  3350. for i := 0 to 3 do
  3351. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3352. inc(aData, s);
  3353. end;
  3354. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3355. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3356. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3357. procedure TbmpColorTableFormat.CreateColorTable;
  3358. var
  3359. i: Integer;
  3360. begin
  3361. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3362. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3363. if (Format = tfLuminance4) then
  3364. SetLength(fColorTable, 16)
  3365. else
  3366. SetLength(fColorTable, 256);
  3367. case Format of
  3368. tfLuminance4: begin
  3369. for i := 0 to High(fColorTable) do begin
  3370. fColorTable[i].r := 16 * i;
  3371. fColorTable[i].g := 16 * i;
  3372. fColorTable[i].b := 16 * i;
  3373. fColorTable[i].a := 0;
  3374. end;
  3375. end;
  3376. tfLuminance8: begin
  3377. for i := 0 to High(fColorTable) do begin
  3378. fColorTable[i].r := i;
  3379. fColorTable[i].g := i;
  3380. fColorTable[i].b := i;
  3381. fColorTable[i].a := 0;
  3382. end;
  3383. end;
  3384. tfR3G3B2: begin
  3385. for i := 0 to High(fColorTable) do begin
  3386. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3387. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3388. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3389. fColorTable[i].a := 0;
  3390. end;
  3391. end;
  3392. end;
  3393. end;
  3394. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3395. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3396. var
  3397. d: Byte;
  3398. begin
  3399. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3400. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3401. case Format of
  3402. tfLuminance4: begin
  3403. if (aMapData = nil) then
  3404. aData^ := 0;
  3405. d := LuminanceWeight(aPixel) and Range.r;
  3406. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3407. inc(PByte(aMapData), 4);
  3408. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3409. inc(aData);
  3410. aMapData := nil;
  3411. end;
  3412. end;
  3413. tfLuminance8: begin
  3414. aData^ := LuminanceWeight(aPixel) and Range.r;
  3415. inc(aData);
  3416. end;
  3417. tfR3G3B2: begin
  3418. aData^ := Round(
  3419. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3420. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3421. ((aPixel.Data.b and Range.b) shl Shift.b));
  3422. inc(aData);
  3423. end;
  3424. end;
  3425. end;
  3426. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3427. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3428. var
  3429. idx: QWord;
  3430. s: Integer;
  3431. bits: Byte;
  3432. f: Single;
  3433. begin
  3434. s := Trunc(fPixelSize);
  3435. f := fPixelSize - s;
  3436. bits := Round(8 * f);
  3437. case s of
  3438. 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
  3439. 1: idx := aData^;
  3440. 2: idx := PWord(aData)^;
  3441. 4: idx := PCardinal(aData)^;
  3442. 8: idx := PQWord(aData)^;
  3443. else
  3444. raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3445. end;
  3446. if (idx >= Length(fColorTable)) then
  3447. raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
  3448. with fColorTable[idx] do begin
  3449. aPixel.Data.r := r;
  3450. aPixel.Data.g := g;
  3451. aPixel.Data.b := b;
  3452. aPixel.Data.a := a;
  3453. end;
  3454. inc(PByte(aMapData), bits);
  3455. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3456. inc(aData, 1);
  3457. dec(PByte(aMapData), 8);
  3458. end;
  3459. inc(aData, s);
  3460. end;
  3461. destructor TbmpColorTableFormat.Destroy;
  3462. begin
  3463. SetLength(fColorTable, 0);
  3464. inherited Destroy;
  3465. end;
  3466. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3467. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3468. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3469. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3470. var
  3471. i: Integer;
  3472. begin
  3473. for i := 0 to 3 do begin
  3474. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3475. if (aSourceFD.Range.arr[i] > 0) then
  3476. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3477. else
  3478. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3479. end;
  3480. end;
  3481. end;
  3482. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3483. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3484. begin
  3485. with aFuncRec do begin
  3486. if (Source.Range.r > 0) then
  3487. Dest.Data.r := Source.Data.r;
  3488. if (Source.Range.g > 0) then
  3489. Dest.Data.g := Source.Data.g;
  3490. if (Source.Range.b > 0) then
  3491. Dest.Data.b := Source.Data.b;
  3492. if (Source.Range.a > 0) then
  3493. Dest.Data.a := Source.Data.a;
  3494. end;
  3495. end;
  3496. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3497. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3498. var
  3499. i: Integer;
  3500. begin
  3501. with aFuncRec do begin
  3502. for i := 0 to 3 do
  3503. if (Source.Range.arr[i] > 0) then
  3504. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3505. end;
  3506. end;
  3507. type
  3508. TShiftData = packed record
  3509. case Integer of
  3510. 0: (r, g, b, a: SmallInt);
  3511. 1: (arr: array[0..3] of SmallInt);
  3512. end;
  3513. PShiftData = ^TShiftData;
  3514. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3515. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3516. var
  3517. i: Integer;
  3518. begin
  3519. with aFuncRec do
  3520. for i := 0 to 3 do
  3521. if (Source.Range.arr[i] > 0) then
  3522. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3523. end;
  3524. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3525. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3526. begin
  3527. with aFuncRec do begin
  3528. Dest.Data := Source.Data;
  3529. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3530. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3531. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3532. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3533. end;
  3534. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3535. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3536. end;
  3537. end;
  3538. end;
  3539. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3540. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3541. var
  3542. i: Integer;
  3543. begin
  3544. with aFuncRec do begin
  3545. for i := 0 to 3 do
  3546. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3547. end;
  3548. end;
  3549. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3550. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3551. var
  3552. Temp: Single;
  3553. begin
  3554. with FuncRec do begin
  3555. if (FuncRec.Args = nil) then begin //source has no alpha
  3556. Temp :=
  3557. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3558. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3559. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3560. Dest.Data.a := Round(Dest.Range.a * Temp);
  3561. end else
  3562. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3563. end;
  3564. end;
  3565. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3566. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3567. type
  3568. PglBitmapPixelData = ^TglBitmapPixelData;
  3569. begin
  3570. with FuncRec do begin
  3571. Dest.Data.r := Source.Data.r;
  3572. Dest.Data.g := Source.Data.g;
  3573. Dest.Data.b := Source.Data.b;
  3574. with PglBitmapPixelData(Args)^ do
  3575. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3576. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3577. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3578. Dest.Data.a := 0
  3579. else
  3580. Dest.Data.a := Dest.Range.a;
  3581. end;
  3582. end;
  3583. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3584. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3585. begin
  3586. with FuncRec do begin
  3587. Dest.Data.r := Source.Data.r;
  3588. Dest.Data.g := Source.Data.g;
  3589. Dest.Data.b := Source.Data.b;
  3590. Dest.Data.a := PCardinal(Args)^;
  3591. end;
  3592. end;
  3593. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3594. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3595. type
  3596. PRGBPix = ^TRGBPix;
  3597. TRGBPix = array [0..2] of byte;
  3598. var
  3599. Temp: Byte;
  3600. begin
  3601. while aWidth > 0 do begin
  3602. Temp := PRGBPix(aData)^[0];
  3603. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3604. PRGBPix(aData)^[2] := Temp;
  3605. if aHasAlpha then
  3606. Inc(aData, 4)
  3607. else
  3608. Inc(aData, 3);
  3609. dec(aWidth);
  3610. end;
  3611. end;
  3612. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3613. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3614. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3615. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  3616. begin
  3617. result := TFormatDescriptor.Get(Format);
  3618. end;
  3619. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3620. function TglBitmap.GetWidth: Integer;
  3621. begin
  3622. if (ffX in fDimension.Fields) then
  3623. result := fDimension.X
  3624. else
  3625. result := -1;
  3626. end;
  3627. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3628. function TglBitmap.GetHeight: Integer;
  3629. begin
  3630. if (ffY in fDimension.Fields) then
  3631. result := fDimension.Y
  3632. else
  3633. result := -1;
  3634. end;
  3635. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3636. function TglBitmap.GetFileWidth: Integer;
  3637. begin
  3638. result := Max(1, Width);
  3639. end;
  3640. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3641. function TglBitmap.GetFileHeight: Integer;
  3642. begin
  3643. result := Max(1, Height);
  3644. end;
  3645. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3646. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3647. begin
  3648. if fCustomData = aValue then
  3649. exit;
  3650. fCustomData := aValue;
  3651. end;
  3652. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3653. procedure TglBitmap.SetCustomName(const aValue: String);
  3654. begin
  3655. if fCustomName = aValue then
  3656. exit;
  3657. fCustomName := aValue;
  3658. end;
  3659. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3660. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3661. begin
  3662. if fCustomNameW = aValue then
  3663. exit;
  3664. fCustomNameW := aValue;
  3665. end;
  3666. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3667. procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
  3668. begin
  3669. if fFreeDataOnDestroy = aValue then
  3670. exit;
  3671. fFreeDataOnDestroy := aValue;
  3672. end;
  3673. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3674. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3675. begin
  3676. if fDeleteTextureOnFree = aValue then
  3677. exit;
  3678. fDeleteTextureOnFree := aValue;
  3679. end;
  3680. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3681. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3682. begin
  3683. if fFormat = aValue then
  3684. exit;
  3685. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3686. raise EglBitmapUnsupportedFormat.Create(Format);
  3687. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  3688. end;
  3689. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3690. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3691. begin
  3692. if fFreeDataAfterGenTexture = aValue then
  3693. exit;
  3694. fFreeDataAfterGenTexture := aValue;
  3695. end;
  3696. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3697. procedure TglBitmap.SetID(const aValue: Cardinal);
  3698. begin
  3699. if fID = aValue then
  3700. exit;
  3701. fID := aValue;
  3702. end;
  3703. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3704. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3705. begin
  3706. if fMipMap = aValue then
  3707. exit;
  3708. fMipMap := aValue;
  3709. end;
  3710. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3711. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3712. begin
  3713. if fTarget = aValue then
  3714. exit;
  3715. fTarget := aValue;
  3716. end;
  3717. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3718. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3719. var
  3720. MaxAnisotropic: Integer;
  3721. begin
  3722. fAnisotropic := aValue;
  3723. if (ID > 0) then begin
  3724. if GL_EXT_texture_filter_anisotropic then begin
  3725. if fAnisotropic > 0 then begin
  3726. Bind(false);
  3727. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3728. if aValue > MaxAnisotropic then
  3729. fAnisotropic := MaxAnisotropic;
  3730. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3731. end;
  3732. end else begin
  3733. fAnisotropic := 0;
  3734. end;
  3735. end;
  3736. end;
  3737. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3738. procedure TglBitmap.CreateID;
  3739. begin
  3740. if (ID <> 0) then
  3741. glDeleteTextures(1, @fID);
  3742. glGenTextures(1, @fID);
  3743. Bind(false);
  3744. end;
  3745. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3746. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3747. begin
  3748. // Set Up Parameters
  3749. SetWrap(fWrapS, fWrapT, fWrapR);
  3750. SetFilter(fFilterMin, fFilterMag);
  3751. SetAnisotropic(fAnisotropic);
  3752. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3753. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  3754. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3755. // Mip Maps Generation Mode
  3756. aBuildWithGlu := false;
  3757. if (MipMap = mmMipmap) then begin
  3758. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3759. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3760. else
  3761. aBuildWithGlu := true;
  3762. end else if (MipMap = mmMipmapGlu) then
  3763. aBuildWithGlu := true;
  3764. end;
  3765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3766. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  3767. const aWidth: Integer; const aHeight: Integer);
  3768. var
  3769. s: Single;
  3770. begin
  3771. if (Data <> aData) then begin
  3772. if (Assigned(Data)) then
  3773. FreeMem(Data);
  3774. fData := aData;
  3775. end;
  3776. if not Assigned(fData) then begin
  3777. fPixelSize := 0;
  3778. fRowSize := 0;
  3779. end else begin
  3780. FillChar(fDimension, SizeOf(fDimension), 0);
  3781. if aWidth <> -1 then begin
  3782. fDimension.Fields := fDimension.Fields + [ffX];
  3783. fDimension.X := aWidth;
  3784. end;
  3785. if aHeight <> -1 then begin
  3786. fDimension.Fields := fDimension.Fields + [ffY];
  3787. fDimension.Y := aHeight;
  3788. end;
  3789. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3790. fFormat := aFormat;
  3791. fPixelSize := Ceil(s);
  3792. fRowSize := Ceil(s * aWidth);
  3793. end;
  3794. end;
  3795. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3796. function TglBitmap.FlipHorz: Boolean;
  3797. begin
  3798. result := false;
  3799. end;
  3800. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3801. function TglBitmap.FlipVert: Boolean;
  3802. begin
  3803. result := false;
  3804. end;
  3805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3806. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3807. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3808. procedure TglBitmap.AfterConstruction;
  3809. begin
  3810. inherited AfterConstruction;
  3811. fID := 0;
  3812. fTarget := 0;
  3813. fIsResident := false;
  3814. fMipMap := glBitmapDefaultMipmap;
  3815. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3816. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3817. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3818. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3819. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3820. end;
  3821. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3822. procedure TglBitmap.BeforeDestruction;
  3823. var
  3824. NewData: PByte;
  3825. begin
  3826. if fFreeDataOnDestroy then begin
  3827. NewData := nil;
  3828. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  3829. end;
  3830. if (fID > 0) and fDeleteTextureOnFree then
  3831. glDeleteTextures(1, @fID);
  3832. inherited BeforeDestruction;
  3833. end;
  3834. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3835. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  3836. var
  3837. TempPos: Integer;
  3838. begin
  3839. if not Assigned(aResType) then begin
  3840. TempPos := Pos('.', aResource);
  3841. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3842. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3843. end;
  3844. end;
  3845. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3846. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3847. var
  3848. fs: TFileStream;
  3849. begin
  3850. if not FileExists(aFilename) then
  3851. raise EglBitmap.Create('file does not exist: ' + aFilename);
  3852. fFilename := aFilename;
  3853. fs := TFileStream.Create(fFilename, fmOpenRead);
  3854. try
  3855. fs.Position := 0;
  3856. LoadFromStream(fs);
  3857. finally
  3858. fs.Free;
  3859. end;
  3860. end;
  3861. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3862. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3863. begin
  3864. {$IFDEF GLB_SUPPORT_PNG_READ}
  3865. if not LoadPNG(aStream) then
  3866. {$ENDIF}
  3867. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3868. if not LoadJPEG(aStream) then
  3869. {$ENDIF}
  3870. if not LoadDDS(aStream) then
  3871. if not LoadTGA(aStream) then
  3872. if not LoadBMP(aStream) then
  3873. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3874. end;
  3875. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3876. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3877. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3878. var
  3879. tmpData: PByte;
  3880. size: Integer;
  3881. begin
  3882. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3883. GetMem(tmpData, size);
  3884. try
  3885. FillChar(tmpData^, size, #$FF);
  3886. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  3887. except
  3888. if Assigned(tmpData) then
  3889. FreeMem(tmpData);
  3890. raise;
  3891. end;
  3892. AddFunc(Self, aFunc, false, aFormat, aArgs);
  3893. end;
  3894. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3895. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  3896. var
  3897. rs: TResourceStream;
  3898. begin
  3899. PrepareResType(aResource, aResType);
  3900. rs := TResourceStream.Create(aInstance, aResource, aResType);
  3901. try
  3902. LoadFromStream(rs);
  3903. finally
  3904. rs.Free;
  3905. end;
  3906. end;
  3907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3908. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3909. var
  3910. rs: TResourceStream;
  3911. begin
  3912. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  3913. try
  3914. LoadFromStream(rs);
  3915. finally
  3916. rs.Free;
  3917. end;
  3918. end;
  3919. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3920. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3921. var
  3922. fs: TFileStream;
  3923. begin
  3924. fs := TFileStream.Create(aFileName, fmCreate);
  3925. try
  3926. fs.Position := 0;
  3927. SaveToStream(fs, aFileType);
  3928. finally
  3929. fs.Free;
  3930. end;
  3931. end;
  3932. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3933. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3934. begin
  3935. case aFileType of
  3936. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3937. ftPNG: SavePNG(aStream);
  3938. {$ENDIF}
  3939. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3940. ftJPEG: SaveJPEG(aStream);
  3941. {$ENDIF}
  3942. ftDDS: SaveDDS(aStream);
  3943. ftTGA: SaveTGA(aStream);
  3944. ftBMP: SaveBMP(aStream);
  3945. end;
  3946. end;
  3947. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3948. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3949. begin
  3950. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3951. end;
  3952. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3953. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3954. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3955. var
  3956. DestData, TmpData, SourceData: pByte;
  3957. TempHeight, TempWidth: Integer;
  3958. SourceFD, DestFD: TFormatDescriptor;
  3959. SourceMD, DestMD: Pointer;
  3960. FuncRec: TglBitmapFunctionRec;
  3961. begin
  3962. Assert(Assigned(Data));
  3963. Assert(Assigned(aSource));
  3964. Assert(Assigned(aSource.Data));
  3965. result := false;
  3966. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3967. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3968. DestFD := TFormatDescriptor.Get(aFormat);
  3969. if (SourceFD.IsCompressed) then
  3970. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  3971. if (DestFD.IsCompressed) then
  3972. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  3973. // inkompatible Formats so CreateTemp
  3974. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3975. aCreateTemp := true;
  3976. // Values
  3977. TempHeight := Max(1, aSource.Height);
  3978. TempWidth := Max(1, aSource.Width);
  3979. FuncRec.Sender := Self;
  3980. FuncRec.Args := aArgs;
  3981. TmpData := nil;
  3982. if aCreateTemp then begin
  3983. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  3984. DestData := TmpData;
  3985. end else
  3986. DestData := Data;
  3987. try
  3988. SourceFD.PreparePixel(FuncRec.Source);
  3989. DestFD.PreparePixel (FuncRec.Dest);
  3990. SourceMD := SourceFD.CreateMappingData;
  3991. DestMD := DestFD.CreateMappingData;
  3992. FuncRec.Size := aSource.Dimension;
  3993. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3994. try
  3995. SourceData := aSource.Data;
  3996. FuncRec.Position.Y := 0;
  3997. while FuncRec.Position.Y < TempHeight do begin
  3998. FuncRec.Position.X := 0;
  3999. while FuncRec.Position.X < TempWidth do begin
  4000. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4001. aFunc(FuncRec);
  4002. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  4003. inc(FuncRec.Position.X);
  4004. end;
  4005. inc(FuncRec.Position.Y);
  4006. end;
  4007. // Updating Image or InternalFormat
  4008. if aCreateTemp then
  4009. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  4010. else if (aFormat <> fFormat) then
  4011. Format := aFormat;
  4012. result := true;
  4013. finally
  4014. SourceFD.FreeMappingData(SourceMD);
  4015. DestFD.FreeMappingData(DestMD);
  4016. end;
  4017. except
  4018. if aCreateTemp and Assigned(TmpData) then
  4019. FreeMem(TmpData);
  4020. raise;
  4021. end;
  4022. end;
  4023. end;
  4024. {$IFDEF GLB_SDL}
  4025. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4026. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  4027. var
  4028. Row, RowSize: Integer;
  4029. SourceData, TmpData: PByte;
  4030. TempDepth: Integer;
  4031. FormatDesc: TFormatDescriptor;
  4032. function GetRowPointer(Row: Integer): pByte;
  4033. begin
  4034. result := aSurface.pixels;
  4035. Inc(result, Row * RowSize);
  4036. end;
  4037. begin
  4038. result := false;
  4039. FormatDesc := TFormatDescriptor.Get(Format);
  4040. if FormatDesc.IsCompressed then
  4041. raise EglBitmapUnsupportedFormat.Create(Format);
  4042. if Assigned(Data) then begin
  4043. case Trunc(FormatDesc.PixelSize) of
  4044. 1: TempDepth := 8;
  4045. 2: TempDepth := 16;
  4046. 3: TempDepth := 24;
  4047. 4: TempDepth := 32;
  4048. else
  4049. raise EglBitmapUnsupportedFormat.Create(Format);
  4050. end;
  4051. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4052. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4053. SourceData := Data;
  4054. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4055. for Row := 0 to FileHeight-1 do begin
  4056. TmpData := GetRowPointer(Row);
  4057. if Assigned(TmpData) then begin
  4058. Move(SourceData^, TmpData^, RowSize);
  4059. inc(SourceData, RowSize);
  4060. end;
  4061. end;
  4062. result := true;
  4063. end;
  4064. end;
  4065. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4066. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4067. var
  4068. pSource, pData, pTempData: PByte;
  4069. Row, RowSize, TempWidth, TempHeight: Integer;
  4070. IntFormat: TglBitmapFormat;
  4071. FormatDesc: TFormatDescriptor;
  4072. function GetRowPointer(Row: Integer): pByte;
  4073. begin
  4074. result := aSurface^.pixels;
  4075. Inc(result, Row * RowSize);
  4076. end;
  4077. begin
  4078. result := false;
  4079. if (Assigned(aSurface)) then begin
  4080. with aSurface^.format^ do begin
  4081. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  4082. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4083. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  4084. break;
  4085. end;
  4086. if (IntFormat = tfEmpty) then
  4087. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  4088. end;
  4089. TempWidth := aSurface^.w;
  4090. TempHeight := aSurface^.h;
  4091. RowSize := FormatDesc.GetSize(TempWidth, 1);
  4092. GetMem(pData, TempHeight * RowSize);
  4093. try
  4094. pTempData := pData;
  4095. for Row := 0 to TempHeight -1 do begin
  4096. pSource := GetRowPointer(Row);
  4097. if (Assigned(pSource)) then begin
  4098. Move(pSource^, pTempData^, RowSize);
  4099. Inc(pTempData, RowSize);
  4100. end;
  4101. end;
  4102. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4103. result := true;
  4104. except
  4105. if Assigned(pData) then
  4106. FreeMem(pData);
  4107. raise;
  4108. end;
  4109. end;
  4110. end;
  4111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4112. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4113. var
  4114. Row, Col, AlphaInterleave: Integer;
  4115. pSource, pDest: PByte;
  4116. function GetRowPointer(Row: Integer): pByte;
  4117. begin
  4118. result := aSurface.pixels;
  4119. Inc(result, Row * Width);
  4120. end;
  4121. begin
  4122. result := false;
  4123. if Assigned(Data) then begin
  4124. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  4125. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4126. AlphaInterleave := 0;
  4127. case Format of
  4128. tfLuminance8Alpha8:
  4129. AlphaInterleave := 1;
  4130. tfBGRA8, tfRGBA8:
  4131. AlphaInterleave := 3;
  4132. end;
  4133. pSource := Data;
  4134. for Row := 0 to Height -1 do begin
  4135. pDest := GetRowPointer(Row);
  4136. if Assigned(pDest) then begin
  4137. for Col := 0 to Width -1 do begin
  4138. Inc(pSource, AlphaInterleave);
  4139. pDest^ := pSource^;
  4140. Inc(pDest);
  4141. Inc(pSource);
  4142. end;
  4143. end;
  4144. end;
  4145. result := true;
  4146. end;
  4147. end;
  4148. end;
  4149. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4150. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4151. var
  4152. bmp: TglBitmap2D;
  4153. begin
  4154. bmp := TglBitmap2D.Create;
  4155. try
  4156. bmp.AssignFromSurface(aSurface);
  4157. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4158. finally
  4159. bmp.Free;
  4160. end;
  4161. end;
  4162. {$ENDIF}
  4163. {$IFDEF GLB_DELPHI}
  4164. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4165. function CreateGrayPalette: HPALETTE;
  4166. var
  4167. Idx: Integer;
  4168. Pal: PLogPalette;
  4169. begin
  4170. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4171. Pal.palVersion := $300;
  4172. Pal.palNumEntries := 256;
  4173. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4174. Pal.palPalEntry[Idx].peRed := Idx;
  4175. Pal.palPalEntry[Idx].peGreen := Idx;
  4176. Pal.palPalEntry[Idx].peBlue := Idx;
  4177. Pal.palPalEntry[Idx].peFlags := 0;
  4178. end;
  4179. Result := CreatePalette(Pal^);
  4180. FreeMem(Pal);
  4181. end;
  4182. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4183. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4184. var
  4185. Row: Integer;
  4186. pSource, pData: PByte;
  4187. begin
  4188. result := false;
  4189. if Assigned(Data) then begin
  4190. if Assigned(aBitmap) then begin
  4191. aBitmap.Width := Width;
  4192. aBitmap.Height := Height;
  4193. case Format of
  4194. tfAlpha8, tfLuminance8: begin
  4195. aBitmap.PixelFormat := pf8bit;
  4196. aBitmap.Palette := CreateGrayPalette;
  4197. end;
  4198. tfRGB5A1:
  4199. aBitmap.PixelFormat := pf15bit;
  4200. tfR5G6B5:
  4201. aBitmap.PixelFormat := pf16bit;
  4202. tfRGB8, tfBGR8:
  4203. aBitmap.PixelFormat := pf24bit;
  4204. tfRGBA8, tfBGRA8:
  4205. aBitmap.PixelFormat := pf32bit;
  4206. else
  4207. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4208. end;
  4209. pSource := Data;
  4210. for Row := 0 to FileHeight -1 do begin
  4211. pData := aBitmap.Scanline[Row];
  4212. Move(pSource^, pData^, fRowSize);
  4213. Inc(pSource, fRowSize);
  4214. if (Format in [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A)
  4215. SwapRGB(pData, FileWidth, Format = tfRGBA8);
  4216. end;
  4217. result := true;
  4218. end;
  4219. end;
  4220. end;
  4221. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4222. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4223. var
  4224. pSource, pData, pTempData: PByte;
  4225. Row, RowSize, TempWidth, TempHeight: Integer;
  4226. IntFormat: TglBitmapFormat;
  4227. begin
  4228. result := false;
  4229. if (Assigned(aBitmap)) then begin
  4230. case aBitmap.PixelFormat of
  4231. pf8bit:
  4232. IntFormat := tfLuminance8;
  4233. pf15bit:
  4234. IntFormat := tfRGB5A1;
  4235. pf16bit:
  4236. IntFormat := tfR5G6B5;
  4237. pf24bit:
  4238. IntFormat := tfBGR8;
  4239. pf32bit:
  4240. IntFormat := tfBGRA8;
  4241. else
  4242. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4243. end;
  4244. TempWidth := aBitmap.Width;
  4245. TempHeight := aBitmap.Height;
  4246. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4247. GetMem(pData, TempHeight * RowSize);
  4248. try
  4249. pTempData := pData;
  4250. for Row := 0 to TempHeight -1 do begin
  4251. pSource := aBitmap.Scanline[Row];
  4252. if (Assigned(pSource)) then begin
  4253. Move(pSource^, pTempData^, RowSize);
  4254. Inc(pTempData, RowSize);
  4255. end;
  4256. end;
  4257. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4258. result := true;
  4259. except
  4260. if Assigned(pData) then
  4261. FreeMem(pData);
  4262. raise;
  4263. end;
  4264. end;
  4265. end;
  4266. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4267. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4268. var
  4269. Row, Col, AlphaInterleave: Integer;
  4270. pSource, pDest: PByte;
  4271. begin
  4272. result := false;
  4273. if Assigned(Data) then begin
  4274. if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
  4275. if Assigned(aBitmap) then begin
  4276. aBitmap.PixelFormat := pf8bit;
  4277. aBitmap.Palette := CreateGrayPalette;
  4278. aBitmap.Width := Width;
  4279. aBitmap.Height := Height;
  4280. case Format of
  4281. tfLuminance8Alpha8:
  4282. AlphaInterleave := 1;
  4283. tfRGBA8, tfBGRA8:
  4284. AlphaInterleave := 3;
  4285. else
  4286. AlphaInterleave := 0;
  4287. end;
  4288. // Copy Data
  4289. pSource := Data;
  4290. for Row := 0 to Height -1 do begin
  4291. pDest := aBitmap.Scanline[Row];
  4292. if Assigned(pDest) then begin
  4293. for Col := 0 to Width -1 do begin
  4294. Inc(pSource, AlphaInterleave);
  4295. pDest^ := pSource^;
  4296. Inc(pDest);
  4297. Inc(pSource);
  4298. end;
  4299. end;
  4300. end;
  4301. result := true;
  4302. end;
  4303. end;
  4304. end;
  4305. end;
  4306. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4307. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4308. var
  4309. tex: TglBitmap2D;
  4310. begin
  4311. tex := TglBitmap2D.Create;
  4312. try
  4313. tex.AssignFromBitmap(ABitmap);
  4314. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4315. finally
  4316. tex.Free;
  4317. end;
  4318. end;
  4319. {$ENDIF}
  4320. {$IFDEF GLB_LAZARUS}
  4321. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4322. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4323. var
  4324. rid: TRawImageDescription;
  4325. FormatDesc: TFormatDescriptor;
  4326. begin
  4327. result := false;
  4328. if not Assigned(aImage) or (Format = tfEmpty) then
  4329. exit;
  4330. FormatDesc := TFormatDescriptor.Get(Format);
  4331. if FormatDesc.IsCompressed then
  4332. exit;
  4333. FillChar(rid{%H-}, SizeOf(rid), 0);
  4334. if (Format in [
  4335. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  4336. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  4337. tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
  4338. rid.Format := ricfGray
  4339. else
  4340. rid.Format := ricfRGBA;
  4341. rid.Width := Width;
  4342. rid.Height := Height;
  4343. rid.Depth := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
  4344. rid.BitOrder := riboBitsInOrder;
  4345. rid.ByteOrder := riboLSBFirst;
  4346. rid.LineOrder := riloTopToBottom;
  4347. rid.LineEnd := rileTight;
  4348. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4349. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4350. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4351. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4352. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4353. rid.RedShift := FormatDesc.Shift.r;
  4354. rid.GreenShift := FormatDesc.Shift.g;
  4355. rid.BlueShift := FormatDesc.Shift.b;
  4356. rid.AlphaShift := FormatDesc.Shift.a;
  4357. rid.MaskBitsPerPixel := 0;
  4358. rid.PaletteColorCount := 0;
  4359. aImage.DataDescription := rid;
  4360. aImage.CreateData;
  4361. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4362. result := true;
  4363. end;
  4364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4365. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4366. var
  4367. f: TglBitmapFormat;
  4368. FormatDesc: TFormatDescriptor;
  4369. ImageData: PByte;
  4370. ImageSize: Integer;
  4371. CanCopy: Boolean;
  4372. procedure CopyConvert;
  4373. var
  4374. bfFormat: TbmpBitfieldFormat;
  4375. pSourceLine, pDestLine: PByte;
  4376. pSourceMD, pDestMD: Pointer;
  4377. x, y: Integer;
  4378. pixel: TglBitmapPixelData;
  4379. begin
  4380. bfFormat := TbmpBitfieldFormat.Create;
  4381. with aImage.DataDescription do begin
  4382. bfFormat.RedMask := ((1 shl RedPrec) - 1) shl RedShift;
  4383. bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
  4384. bfFormat.BlueMask := ((1 shl BluePrec) - 1) shl BlueShift;
  4385. bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
  4386. bfFormat.PixelSize := BitsPerPixel / 8;
  4387. end;
  4388. pSourceMD := bfFormat.CreateMappingData;
  4389. pDestMD := FormatDesc.CreateMappingData;
  4390. try
  4391. for y := 0 to aImage.Height-1 do begin
  4392. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  4393. pDestLine := ImageData + y * Round(FormatDesc.PixelSize * aImage.Width);
  4394. for x := 0 to aImage.Width-1 do begin
  4395. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  4396. FormatDesc.Map(pixel, pDestLine, pDestMD);
  4397. end;
  4398. end;
  4399. finally
  4400. FormatDesc.FreeMappingData(pDestMD);
  4401. bfFormat.FreeMappingData(pSourceMD);
  4402. bfFormat.Free;
  4403. end;
  4404. end;
  4405. begin
  4406. result := false;
  4407. if not Assigned(aImage) then
  4408. exit;
  4409. for f := High(f) downto Low(f) do begin
  4410. FormatDesc := TFormatDescriptor.Get(f);
  4411. with aImage.DataDescription do
  4412. if FormatDesc.MaskMatch(
  4413. (QWord(1 shl RedPrec )-1) shl RedShift,
  4414. (QWord(1 shl GreenPrec)-1) shl GreenShift,
  4415. (QWord(1 shl BluePrec )-1) shl BlueShift,
  4416. (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
  4417. break;
  4418. end;
  4419. if (f = tfEmpty) then
  4420. exit;
  4421. CanCopy :=
  4422. (Round(FormatDesc.PixelSize * 8) = aImage.DataDescription.Depth) and
  4423. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  4424. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4425. ImageData := GetMem(ImageSize);
  4426. try
  4427. if CanCopy then
  4428. Move(aImage.PixelData^, ImageData^, ImageSize)
  4429. else
  4430. CopyConvert;
  4431. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4432. except
  4433. if Assigned(ImageData) then
  4434. FreeMem(ImageData);
  4435. raise;
  4436. end;
  4437. result := true;
  4438. end;
  4439. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4440. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4441. var
  4442. rid: TRawImageDescription;
  4443. FormatDesc: TFormatDescriptor;
  4444. Pixel: TglBitmapPixelData;
  4445. x, y: Integer;
  4446. srcMD: Pointer;
  4447. src, dst: PByte;
  4448. begin
  4449. result := false;
  4450. if not Assigned(aImage) or (Format = tfEmpty) then
  4451. exit;
  4452. FormatDesc := TFormatDescriptor.Get(Format);
  4453. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4454. exit;
  4455. FillChar(rid{%H-}, SizeOf(rid), 0);
  4456. rid.Format := ricfGray;
  4457. rid.Width := Width;
  4458. rid.Height := Height;
  4459. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4460. rid.BitOrder := riboBitsInOrder;
  4461. rid.ByteOrder := riboLSBFirst;
  4462. rid.LineOrder := riloTopToBottom;
  4463. rid.LineEnd := rileTight;
  4464. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4465. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4466. rid.GreenPrec := 0;
  4467. rid.BluePrec := 0;
  4468. rid.AlphaPrec := 0;
  4469. rid.RedShift := 0;
  4470. rid.GreenShift := 0;
  4471. rid.BlueShift := 0;
  4472. rid.AlphaShift := 0;
  4473. rid.MaskBitsPerPixel := 0;
  4474. rid.PaletteColorCount := 0;
  4475. aImage.DataDescription := rid;
  4476. aImage.CreateData;
  4477. srcMD := FormatDesc.CreateMappingData;
  4478. try
  4479. FormatDesc.PreparePixel(Pixel);
  4480. src := Data;
  4481. dst := aImage.PixelData;
  4482. for y := 0 to Height-1 do
  4483. for x := 0 to Width-1 do begin
  4484. FormatDesc.Unmap(src, Pixel, srcMD);
  4485. case rid.BitsPerPixel of
  4486. 8: begin
  4487. dst^ := Pixel.Data.a;
  4488. inc(dst);
  4489. end;
  4490. 16: begin
  4491. PWord(dst)^ := Pixel.Data.a;
  4492. inc(dst, 2);
  4493. end;
  4494. 24: begin
  4495. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4496. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4497. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4498. inc(dst, 3);
  4499. end;
  4500. 32: begin
  4501. PCardinal(dst)^ := Pixel.Data.a;
  4502. inc(dst, 4);
  4503. end;
  4504. else
  4505. raise EglBitmapUnsupportedFormat.Create(Format);
  4506. end;
  4507. end;
  4508. finally
  4509. FormatDesc.FreeMappingData(srcMD);
  4510. end;
  4511. result := true;
  4512. end;
  4513. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4514. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4515. var
  4516. tex: TglBitmap2D;
  4517. begin
  4518. tex := TglBitmap2D.Create;
  4519. try
  4520. tex.AssignFromLazIntfImage(aImage);
  4521. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4522. finally
  4523. tex.Free;
  4524. end;
  4525. end;
  4526. {$ENDIF}
  4527. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4528. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4529. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4530. var
  4531. rs: TResourceStream;
  4532. begin
  4533. PrepareResType(aResource, aResType);
  4534. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4535. try
  4536. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4537. finally
  4538. rs.Free;
  4539. end;
  4540. end;
  4541. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4542. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4543. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4544. var
  4545. rs: TResourceStream;
  4546. begin
  4547. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4548. try
  4549. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4550. finally
  4551. rs.Free;
  4552. end;
  4553. end;
  4554. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4555. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4556. begin
  4557. if TFormatDescriptor.Get(Format).IsCompressed then
  4558. raise EglBitmapUnsupportedFormat.Create(Format);
  4559. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4560. end;
  4561. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4562. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4563. var
  4564. FS: TFileStream;
  4565. begin
  4566. FS := TFileStream.Create(aFileName, fmOpenRead);
  4567. try
  4568. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4569. finally
  4570. FS.Free;
  4571. end;
  4572. end;
  4573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4574. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4575. var
  4576. tex: TglBitmap2D;
  4577. begin
  4578. tex := TglBitmap2D.Create(aStream);
  4579. try
  4580. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4581. finally
  4582. tex.Free;
  4583. end;
  4584. end;
  4585. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4586. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4587. var
  4588. DestData, DestData2, SourceData: pByte;
  4589. TempHeight, TempWidth: Integer;
  4590. SourceFD, DestFD: TFormatDescriptor;
  4591. SourceMD, DestMD, DestMD2: Pointer;
  4592. FuncRec: TglBitmapFunctionRec;
  4593. begin
  4594. result := false;
  4595. Assert(Assigned(Data));
  4596. Assert(Assigned(aBitmap));
  4597. Assert(Assigned(aBitmap.Data));
  4598. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4599. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4600. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4601. DestFD := TFormatDescriptor.Get(Format);
  4602. if not Assigned(aFunc) then begin
  4603. aFunc := glBitmapAlphaFunc;
  4604. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4605. end else
  4606. FuncRec.Args := aArgs;
  4607. // Values
  4608. TempHeight := aBitmap.FileHeight;
  4609. TempWidth := aBitmap.FileWidth;
  4610. FuncRec.Sender := Self;
  4611. FuncRec.Size := Dimension;
  4612. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4613. DestData := Data;
  4614. DestData2 := Data;
  4615. SourceData := aBitmap.Data;
  4616. // Mapping
  4617. SourceFD.PreparePixel(FuncRec.Source);
  4618. DestFD.PreparePixel (FuncRec.Dest);
  4619. SourceMD := SourceFD.CreateMappingData;
  4620. DestMD := DestFD.CreateMappingData;
  4621. DestMD2 := DestFD.CreateMappingData;
  4622. try
  4623. FuncRec.Position.Y := 0;
  4624. while FuncRec.Position.Y < TempHeight do begin
  4625. FuncRec.Position.X := 0;
  4626. while FuncRec.Position.X < TempWidth do begin
  4627. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4628. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4629. aFunc(FuncRec);
  4630. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4631. inc(FuncRec.Position.X);
  4632. end;
  4633. inc(FuncRec.Position.Y);
  4634. end;
  4635. finally
  4636. SourceFD.FreeMappingData(SourceMD);
  4637. DestFD.FreeMappingData(DestMD);
  4638. DestFD.FreeMappingData(DestMD2);
  4639. end;
  4640. end;
  4641. end;
  4642. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4643. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4644. begin
  4645. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4646. end;
  4647. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4648. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4649. var
  4650. PixelData: TglBitmapPixelData;
  4651. begin
  4652. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4653. result := AddAlphaFromColorKeyFloat(
  4654. aRed / PixelData.Range.r,
  4655. aGreen / PixelData.Range.g,
  4656. aBlue / PixelData.Range.b,
  4657. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4658. end;
  4659. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4660. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4661. var
  4662. values: array[0..2] of Single;
  4663. tmp: Cardinal;
  4664. i: Integer;
  4665. PixelData: TglBitmapPixelData;
  4666. begin
  4667. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4668. with PixelData do begin
  4669. values[0] := aRed;
  4670. values[1] := aGreen;
  4671. values[2] := aBlue;
  4672. for i := 0 to 2 do begin
  4673. tmp := Trunc(Range.arr[i] * aDeviation);
  4674. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4675. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4676. end;
  4677. Data.a := 0;
  4678. Range.a := 0;
  4679. end;
  4680. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4681. end;
  4682. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4683. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4684. begin
  4685. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4686. end;
  4687. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4688. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4689. var
  4690. PixelData: TglBitmapPixelData;
  4691. begin
  4692. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4693. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4694. end;
  4695. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4696. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4697. var
  4698. PixelData: TglBitmapPixelData;
  4699. begin
  4700. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4701. with PixelData do
  4702. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4703. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4704. end;
  4705. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4706. function TglBitmap.RemoveAlpha: Boolean;
  4707. var
  4708. FormatDesc: TFormatDescriptor;
  4709. begin
  4710. result := false;
  4711. FormatDesc := TFormatDescriptor.Get(Format);
  4712. if Assigned(Data) then begin
  4713. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4714. raise EglBitmapUnsupportedFormat.Create(Format);
  4715. result := ConvertTo(FormatDesc.WithoutAlpha);
  4716. end;
  4717. end;
  4718. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4719. function TglBitmap.Clone: TglBitmap;
  4720. var
  4721. Temp: TglBitmap;
  4722. TempPtr: PByte;
  4723. Size: Integer;
  4724. begin
  4725. result := nil;
  4726. Temp := (ClassType.Create as TglBitmap);
  4727. try
  4728. // copy texture data if assigned
  4729. if Assigned(Data) then begin
  4730. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4731. GetMem(TempPtr, Size);
  4732. try
  4733. Move(Data^, TempPtr^, Size);
  4734. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4735. except
  4736. if Assigned(TempPtr) then
  4737. FreeMem(TempPtr);
  4738. raise;
  4739. end;
  4740. end else begin
  4741. TempPtr := nil;
  4742. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4743. end;
  4744. // copy properties
  4745. Temp.fID := ID;
  4746. Temp.fTarget := Target;
  4747. Temp.fFormat := Format;
  4748. Temp.fMipMap := MipMap;
  4749. Temp.fAnisotropic := Anisotropic;
  4750. Temp.fBorderColor := fBorderColor;
  4751. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4752. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4753. Temp.fFilterMin := fFilterMin;
  4754. Temp.fFilterMag := fFilterMag;
  4755. Temp.fWrapS := fWrapS;
  4756. Temp.fWrapT := fWrapT;
  4757. Temp.fWrapR := fWrapR;
  4758. Temp.fFilename := fFilename;
  4759. Temp.fCustomName := fCustomName;
  4760. Temp.fCustomNameW := fCustomNameW;
  4761. Temp.fCustomData := fCustomData;
  4762. result := Temp;
  4763. except
  4764. FreeAndNil(Temp);
  4765. raise;
  4766. end;
  4767. end;
  4768. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4769. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4770. var
  4771. SourceFD, DestFD: TFormatDescriptor;
  4772. SourcePD, DestPD: TglBitmapPixelData;
  4773. ShiftData: TShiftData;
  4774. function CanCopyDirect: Boolean;
  4775. begin
  4776. result :=
  4777. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4778. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4779. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4780. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4781. end;
  4782. function CanShift: Boolean;
  4783. begin
  4784. result :=
  4785. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4786. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4787. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4788. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4789. end;
  4790. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4791. begin
  4792. result := 0;
  4793. while (aSource > aDest) and (aSource > 0) do begin
  4794. inc(result);
  4795. aSource := aSource shr 1;
  4796. end;
  4797. end;
  4798. begin
  4799. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4800. SourceFD := TFormatDescriptor.Get(Format);
  4801. DestFD := TFormatDescriptor.Get(aFormat);
  4802. SourceFD.PreparePixel(SourcePD);
  4803. DestFD.PreparePixel (DestPD);
  4804. if CanCopyDirect then
  4805. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4806. else if CanShift then begin
  4807. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4808. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4809. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4810. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4811. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4812. end else
  4813. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4814. end else
  4815. result := true;
  4816. end;
  4817. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4818. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4819. begin
  4820. if aUseRGB or aUseAlpha then
  4821. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4822. ((Byte(aUseAlpha) and 1) shl 1) or
  4823. (Byte(aUseRGB) and 1) ));
  4824. end;
  4825. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4826. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4827. begin
  4828. fBorderColor[0] := aRed;
  4829. fBorderColor[1] := aGreen;
  4830. fBorderColor[2] := aBlue;
  4831. fBorderColor[3] := aAlpha;
  4832. if (ID > 0) then begin
  4833. Bind(false);
  4834. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4835. end;
  4836. end;
  4837. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4838. procedure TglBitmap.FreeData;
  4839. var
  4840. TempPtr: PByte;
  4841. begin
  4842. TempPtr := nil;
  4843. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  4844. end;
  4845. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4846. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4847. const aAlpha: Byte);
  4848. begin
  4849. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4850. end;
  4851. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4852. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4853. var
  4854. PixelData: TglBitmapPixelData;
  4855. begin
  4856. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4857. FillWithColorFloat(
  4858. aRed / PixelData.Range.r,
  4859. aGreen / PixelData.Range.g,
  4860. aBlue / PixelData.Range.b,
  4861. aAlpha / PixelData.Range.a);
  4862. end;
  4863. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4864. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4865. var
  4866. PixelData: TglBitmapPixelData;
  4867. begin
  4868. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4869. with PixelData do begin
  4870. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4871. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4872. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4873. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4874. end;
  4875. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4876. end;
  4877. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4878. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  4879. begin
  4880. //check MIN filter
  4881. case aMin of
  4882. GL_NEAREST:
  4883. fFilterMin := GL_NEAREST;
  4884. GL_LINEAR:
  4885. fFilterMin := GL_LINEAR;
  4886. GL_NEAREST_MIPMAP_NEAREST:
  4887. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4888. GL_LINEAR_MIPMAP_NEAREST:
  4889. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4890. GL_NEAREST_MIPMAP_LINEAR:
  4891. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4892. GL_LINEAR_MIPMAP_LINEAR:
  4893. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4894. else
  4895. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  4896. end;
  4897. //check MAG filter
  4898. case aMag of
  4899. GL_NEAREST:
  4900. fFilterMag := GL_NEAREST;
  4901. GL_LINEAR:
  4902. fFilterMag := GL_LINEAR;
  4903. else
  4904. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  4905. end;
  4906. //apply filter
  4907. if (ID > 0) then begin
  4908. Bind(false);
  4909. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4910. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4911. case fFilterMin of
  4912. GL_NEAREST, GL_LINEAR:
  4913. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4914. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4915. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4916. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4917. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4918. end;
  4919. end else
  4920. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4921. end;
  4922. end;
  4923. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4924. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  4925. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4926. begin
  4927. case aValue of
  4928. GL_CLAMP:
  4929. aTarget := GL_CLAMP;
  4930. GL_REPEAT:
  4931. aTarget := GL_REPEAT;
  4932. GL_CLAMP_TO_EDGE: begin
  4933. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4934. aTarget := GL_CLAMP_TO_EDGE
  4935. else
  4936. aTarget := GL_CLAMP;
  4937. end;
  4938. GL_CLAMP_TO_BORDER: begin
  4939. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4940. aTarget := GL_CLAMP_TO_BORDER
  4941. else
  4942. aTarget := GL_CLAMP;
  4943. end;
  4944. GL_MIRRORED_REPEAT: begin
  4945. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4946. aTarget := GL_MIRRORED_REPEAT
  4947. else
  4948. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4949. end;
  4950. else
  4951. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  4952. end;
  4953. end;
  4954. begin
  4955. CheckAndSetWrap(S, fWrapS);
  4956. CheckAndSetWrap(T, fWrapT);
  4957. CheckAndSetWrap(R, fWrapR);
  4958. if (ID > 0) then begin
  4959. Bind(false);
  4960. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4961. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4962. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4963. end;
  4964. end;
  4965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4966. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  4967. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  4968. begin
  4969. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  4970. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  4971. fSwizzle[aIndex] := aValue
  4972. else
  4973. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  4974. end;
  4975. begin
  4976. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4977. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  4978. CheckAndSetValue(r, 0);
  4979. CheckAndSetValue(g, 1);
  4980. CheckAndSetValue(b, 2);
  4981. CheckAndSetValue(a, 3);
  4982. if (ID > 0) then begin
  4983. Bind(false);
  4984. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  4985. end;
  4986. end;
  4987. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4988. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4989. begin
  4990. if aEnableTextureUnit then
  4991. glEnable(Target);
  4992. if (ID > 0) then
  4993. glBindTexture(Target, ID);
  4994. end;
  4995. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4996. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4997. begin
  4998. if aDisableTextureUnit then
  4999. glDisable(Target);
  5000. glBindTexture(Target, 0);
  5001. end;
  5002. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5003. constructor TglBitmap.Create;
  5004. begin
  5005. if (ClassType = TglBitmap) then
  5006. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  5007. {$IFDEF GLB_NATIVE_OGL}
  5008. glbReadOpenGLExtensions;
  5009. {$ENDIF}
  5010. inherited Create;
  5011. fFormat := glBitmapGetDefaultFormat;
  5012. fFreeDataOnDestroy := true;
  5013. end;
  5014. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5015. constructor TglBitmap.Create(const aFileName: String);
  5016. begin
  5017. Create;
  5018. LoadFromFile(aFileName);
  5019. end;
  5020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5021. constructor TglBitmap.Create(const aStream: TStream);
  5022. begin
  5023. Create;
  5024. LoadFromStream(aStream);
  5025. end;
  5026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5027. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
  5028. var
  5029. ImageSize: Integer;
  5030. begin
  5031. Create;
  5032. if not Assigned(aData) then begin
  5033. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5034. GetMem(aData, ImageSize);
  5035. try
  5036. FillChar(aData^, ImageSize, #$FF);
  5037. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5038. except
  5039. if Assigned(aData) then
  5040. FreeMem(aData);
  5041. raise;
  5042. end;
  5043. end else begin
  5044. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5045. fFreeDataOnDestroy := false;
  5046. end;
  5047. end;
  5048. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5049. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5050. begin
  5051. Create;
  5052. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  5053. end;
  5054. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5055. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  5056. begin
  5057. Create;
  5058. LoadFromResource(aInstance, aResource, aResType);
  5059. end;
  5060. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5061. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5062. begin
  5063. Create;
  5064. LoadFromResourceID(aInstance, aResourceID, aResType);
  5065. end;
  5066. {$IFDEF GLB_SUPPORT_PNG_READ}
  5067. {$IF DEFINED(GLB_LAZ_PNG)}
  5068. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5069. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5071. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5072. const
  5073. MAGIC_LEN = 8;
  5074. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  5075. var
  5076. reader: TLazReaderPNG;
  5077. intf: TLazIntfImage;
  5078. StreamPos: Int64;
  5079. magic: String[MAGIC_LEN];
  5080. begin
  5081. result := true;
  5082. StreamPos := aStream.Position;
  5083. SetLength(magic, MAGIC_LEN);
  5084. aStream.Read(magic[1], MAGIC_LEN);
  5085. aStream.Position := StreamPos;
  5086. if (magic <> PNG_MAGIC) then begin
  5087. result := false;
  5088. exit;
  5089. end;
  5090. intf := TLazIntfImage.Create(0, 0);
  5091. reader := TLazReaderPNG.Create;
  5092. try try
  5093. reader.UpdateDescription := true;
  5094. reader.ImageRead(aStream, intf);
  5095. AssignFromLazIntfImage(intf);
  5096. except
  5097. result := false;
  5098. aStream.Position := StreamPos;
  5099. exit;
  5100. end;
  5101. finally
  5102. reader.Free;
  5103. intf.Free;
  5104. end;
  5105. end;
  5106. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5108. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5109. var
  5110. Surface: PSDL_Surface;
  5111. RWops: PSDL_RWops;
  5112. begin
  5113. result := false;
  5114. RWops := glBitmapCreateRWops(aStream);
  5115. try
  5116. if IMG_isPNG(RWops) > 0 then begin
  5117. Surface := IMG_LoadPNG_RW(RWops);
  5118. try
  5119. AssignFromSurface(Surface);
  5120. result := true;
  5121. finally
  5122. SDL_FreeSurface(Surface);
  5123. end;
  5124. end;
  5125. finally
  5126. SDL_FreeRW(RWops);
  5127. end;
  5128. end;
  5129. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5131. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5132. begin
  5133. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5134. end;
  5135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5136. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5137. var
  5138. StreamPos: Int64;
  5139. signature: array [0..7] of byte;
  5140. png: png_structp;
  5141. png_info: png_infop;
  5142. TempHeight, TempWidth: Integer;
  5143. Format: TglBitmapFormat;
  5144. png_data: pByte;
  5145. png_rows: array of pByte;
  5146. Row, LineSize: Integer;
  5147. begin
  5148. result := false;
  5149. if not init_libPNG then
  5150. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5151. try
  5152. // signature
  5153. StreamPos := aStream.Position;
  5154. aStream.Read(signature{%H-}, 8);
  5155. aStream.Position := StreamPos;
  5156. if png_check_sig(@signature, 8) <> 0 then begin
  5157. // png read struct
  5158. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5159. if png = nil then
  5160. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5161. // png info
  5162. png_info := png_create_info_struct(png);
  5163. if png_info = nil then begin
  5164. png_destroy_read_struct(@png, nil, nil);
  5165. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5166. end;
  5167. // set read callback
  5168. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5169. // read informations
  5170. png_read_info(png, png_info);
  5171. // size
  5172. TempHeight := png_get_image_height(png, png_info);
  5173. TempWidth := png_get_image_width(png, png_info);
  5174. // format
  5175. case png_get_color_type(png, png_info) of
  5176. PNG_COLOR_TYPE_GRAY:
  5177. Format := tfLuminance8;
  5178. PNG_COLOR_TYPE_GRAY_ALPHA:
  5179. Format := tfLuminance8Alpha8;
  5180. PNG_COLOR_TYPE_RGB:
  5181. Format := tfRGB8;
  5182. PNG_COLOR_TYPE_RGB_ALPHA:
  5183. Format := tfRGBA8;
  5184. else
  5185. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5186. end;
  5187. // cut upper 8 bit from 16 bit formats
  5188. if png_get_bit_depth(png, png_info) > 8 then
  5189. png_set_strip_16(png);
  5190. // expand bitdepth smaller than 8
  5191. if png_get_bit_depth(png, png_info) < 8 then
  5192. png_set_expand(png);
  5193. // allocating mem for scanlines
  5194. LineSize := png_get_rowbytes(png, png_info);
  5195. GetMem(png_data, TempHeight * LineSize);
  5196. try
  5197. SetLength(png_rows, TempHeight);
  5198. for Row := Low(png_rows) to High(png_rows) do begin
  5199. png_rows[Row] := png_data;
  5200. Inc(png_rows[Row], Row * LineSize);
  5201. end;
  5202. // read complete image into scanlines
  5203. png_read_image(png, @png_rows[0]);
  5204. // read end
  5205. png_read_end(png, png_info);
  5206. // destroy read struct
  5207. png_destroy_read_struct(@png, @png_info, nil);
  5208. SetLength(png_rows, 0);
  5209. // set new data
  5210. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5211. result := true;
  5212. except
  5213. if Assigned(png_data) then
  5214. FreeMem(png_data);
  5215. raise;
  5216. end;
  5217. end;
  5218. finally
  5219. quit_libPNG;
  5220. end;
  5221. end;
  5222. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5223. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5224. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5225. var
  5226. StreamPos: Int64;
  5227. Png: TPNGObject;
  5228. Header: String[8];
  5229. Row, Col, PixSize, LineSize: Integer;
  5230. NewImage, pSource, pDest, pAlpha: pByte;
  5231. PngFormat: TglBitmapFormat;
  5232. FormatDesc: TFormatDescriptor;
  5233. const
  5234. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5235. begin
  5236. result := false;
  5237. StreamPos := aStream.Position;
  5238. aStream.Read(Header[0], SizeOf(Header));
  5239. aStream.Position := StreamPos;
  5240. {Test if the header matches}
  5241. if Header = PngHeader then begin
  5242. Png := TPNGObject.Create;
  5243. try
  5244. Png.LoadFromStream(aStream);
  5245. case Png.Header.ColorType of
  5246. COLOR_GRAYSCALE:
  5247. PngFormat := tfLuminance8;
  5248. COLOR_GRAYSCALEALPHA:
  5249. PngFormat := tfLuminance8Alpha8;
  5250. COLOR_RGB:
  5251. PngFormat := tfBGR8;
  5252. COLOR_RGBALPHA:
  5253. PngFormat := tfBGRA8;
  5254. else
  5255. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5256. end;
  5257. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5258. PixSize := Round(FormatDesc.PixelSize);
  5259. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5260. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5261. try
  5262. pDest := NewImage;
  5263. case Png.Header.ColorType of
  5264. COLOR_RGB, COLOR_GRAYSCALE:
  5265. begin
  5266. for Row := 0 to Png.Height -1 do begin
  5267. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5268. Inc(pDest, LineSize);
  5269. end;
  5270. end;
  5271. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5272. begin
  5273. PixSize := PixSize -1;
  5274. for Row := 0 to Png.Height -1 do begin
  5275. pSource := Png.Scanline[Row];
  5276. pAlpha := pByte(Png.AlphaScanline[Row]);
  5277. for Col := 0 to Png.Width -1 do begin
  5278. Move (pSource^, pDest^, PixSize);
  5279. Inc(pSource, PixSize);
  5280. Inc(pDest, PixSize);
  5281. pDest^ := pAlpha^;
  5282. inc(pAlpha);
  5283. Inc(pDest);
  5284. end;
  5285. end;
  5286. end;
  5287. else
  5288. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5289. end;
  5290. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5291. result := true;
  5292. except
  5293. if Assigned(NewImage) then
  5294. FreeMem(NewImage);
  5295. raise;
  5296. end;
  5297. finally
  5298. Png.Free;
  5299. end;
  5300. end;
  5301. end;
  5302. {$IFEND}
  5303. {$ENDIF}
  5304. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5305. {$IFDEF GLB_LIB_PNG}
  5306. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5307. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5308. begin
  5309. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5310. end;
  5311. {$ENDIF}
  5312. {$IF DEFINED(GLB_LAZ_PNG)}
  5313. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5314. procedure TglBitmap.SavePNG(const aStream: TStream);
  5315. var
  5316. png: TPortableNetworkGraphic;
  5317. intf: TLazIntfImage;
  5318. raw: TRawImage;
  5319. begin
  5320. png := TPortableNetworkGraphic.Create;
  5321. intf := TLazIntfImage.Create(0, 0);
  5322. try
  5323. if not AssignToLazIntfImage(intf) then
  5324. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5325. intf.GetRawImage(raw);
  5326. png.LoadFromRawImage(raw, false);
  5327. png.SaveToStream(aStream);
  5328. finally
  5329. png.Free;
  5330. intf.Free;
  5331. end;
  5332. end;
  5333. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5334. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5335. procedure TglBitmap.SavePNG(const aStream: TStream);
  5336. var
  5337. png: png_structp;
  5338. png_info: png_infop;
  5339. png_rows: array of pByte;
  5340. LineSize: Integer;
  5341. ColorType: Integer;
  5342. Row: Integer;
  5343. FormatDesc: TFormatDescriptor;
  5344. begin
  5345. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5346. raise EglBitmapUnsupportedFormat.Create(Format);
  5347. if not init_libPNG then
  5348. raise Exception.Create('unable to initialize libPNG.');
  5349. try
  5350. case Format of
  5351. tfAlpha8, tfLuminance8:
  5352. ColorType := PNG_COLOR_TYPE_GRAY;
  5353. tfLuminance8Alpha8:
  5354. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5355. tfBGR8, tfRGB8:
  5356. ColorType := PNG_COLOR_TYPE_RGB;
  5357. tfBGRA8, tfRGBA8:
  5358. ColorType := PNG_COLOR_TYPE_RGBA;
  5359. else
  5360. raise EglBitmapUnsupportedFormat.Create(Format);
  5361. end;
  5362. FormatDesc := TFormatDescriptor.Get(Format);
  5363. LineSize := FormatDesc.GetSize(Width, 1);
  5364. // creating array for scanline
  5365. SetLength(png_rows, Height);
  5366. try
  5367. for Row := 0 to Height - 1 do begin
  5368. png_rows[Row] := Data;
  5369. Inc(png_rows[Row], Row * LineSize)
  5370. end;
  5371. // write struct
  5372. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5373. if png = nil then
  5374. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5375. // create png info
  5376. png_info := png_create_info_struct(png);
  5377. if png_info = nil then begin
  5378. png_destroy_write_struct(@png, nil);
  5379. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5380. end;
  5381. // set read callback
  5382. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5383. // set compression
  5384. png_set_compression_level(png, 6);
  5385. if Format in [tfBGR8, tfBGRA8] then
  5386. png_set_bgr(png);
  5387. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5388. png_write_info(png, png_info);
  5389. png_write_image(png, @png_rows[0]);
  5390. png_write_end(png, png_info);
  5391. png_destroy_write_struct(@png, @png_info);
  5392. finally
  5393. SetLength(png_rows, 0);
  5394. end;
  5395. finally
  5396. quit_libPNG;
  5397. end;
  5398. end;
  5399. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5401. procedure TglBitmap.SavePNG(const aStream: TStream);
  5402. var
  5403. Png: TPNGObject;
  5404. pSource, pDest: pByte;
  5405. X, Y, PixSize: Integer;
  5406. ColorType: Cardinal;
  5407. Alpha: Boolean;
  5408. pTemp: pByte;
  5409. Temp: Byte;
  5410. begin
  5411. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5412. raise EglBitmapUnsupportedFormat.Create(Format);
  5413. case Format of
  5414. tfAlpha8, tfLuminance8: begin
  5415. ColorType := COLOR_GRAYSCALE;
  5416. PixSize := 1;
  5417. Alpha := false;
  5418. end;
  5419. tfLuminance8Alpha8: begin
  5420. ColorType := COLOR_GRAYSCALEALPHA;
  5421. PixSize := 1;
  5422. Alpha := true;
  5423. end;
  5424. tfBGR8, tfRGB8: begin
  5425. ColorType := COLOR_RGB;
  5426. PixSize := 3;
  5427. Alpha := false;
  5428. end;
  5429. tfBGRA8, tfRGBA8: begin
  5430. ColorType := COLOR_RGBALPHA;
  5431. PixSize := 3;
  5432. Alpha := true
  5433. end;
  5434. else
  5435. raise EglBitmapUnsupportedFormat.Create(Format);
  5436. end;
  5437. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5438. try
  5439. // Copy ImageData
  5440. pSource := Data;
  5441. for Y := 0 to Height -1 do begin
  5442. pDest := png.ScanLine[Y];
  5443. for X := 0 to Width -1 do begin
  5444. Move(pSource^, pDest^, PixSize);
  5445. Inc(pDest, PixSize);
  5446. Inc(pSource, PixSize);
  5447. if Alpha then begin
  5448. png.AlphaScanline[Y]^[X] := pSource^;
  5449. Inc(pSource);
  5450. end;
  5451. end;
  5452. // convert RGB line to BGR
  5453. if Format in [tfRGB8, tfRGBA8] then begin
  5454. pTemp := png.ScanLine[Y];
  5455. for X := 0 to Width -1 do begin
  5456. Temp := pByteArray(pTemp)^[0];
  5457. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5458. pByteArray(pTemp)^[2] := Temp;
  5459. Inc(pTemp, 3);
  5460. end;
  5461. end;
  5462. end;
  5463. // Save to Stream
  5464. Png.CompressionLevel := 6;
  5465. Png.SaveToStream(aStream);
  5466. finally
  5467. FreeAndNil(Png);
  5468. end;
  5469. end;
  5470. {$IFEND}
  5471. {$ENDIF}
  5472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5473. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5475. {$IFDEF GLB_LIB_JPEG}
  5476. type
  5477. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5478. glBitmap_libJPEG_source_mgr = record
  5479. pub: jpeg_source_mgr;
  5480. SrcStream: TStream;
  5481. SrcBuffer: array [1..4096] of byte;
  5482. end;
  5483. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5484. glBitmap_libJPEG_dest_mgr = record
  5485. pub: jpeg_destination_mgr;
  5486. DestStream: TStream;
  5487. DestBuffer: array [1..4096] of byte;
  5488. end;
  5489. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5490. begin
  5491. //DUMMY
  5492. end;
  5493. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5494. begin
  5495. //DUMMY
  5496. end;
  5497. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5498. begin
  5499. //DUMMY
  5500. end;
  5501. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5502. begin
  5503. //DUMMY
  5504. end;
  5505. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5506. begin
  5507. //DUMMY
  5508. end;
  5509. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5510. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5511. var
  5512. src: glBitmap_libJPEG_source_mgr_ptr;
  5513. bytes: integer;
  5514. begin
  5515. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5516. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5517. if (bytes <= 0) then begin
  5518. src^.SrcBuffer[1] := $FF;
  5519. src^.SrcBuffer[2] := JPEG_EOI;
  5520. bytes := 2;
  5521. end;
  5522. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5523. src^.pub.bytes_in_buffer := bytes;
  5524. result := true;
  5525. end;
  5526. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5527. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5528. var
  5529. src: glBitmap_libJPEG_source_mgr_ptr;
  5530. begin
  5531. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5532. if num_bytes > 0 then begin
  5533. // wanted byte isn't in buffer so set stream position and read buffer
  5534. if num_bytes > src^.pub.bytes_in_buffer then begin
  5535. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5536. src^.pub.fill_input_buffer(cinfo);
  5537. end else begin
  5538. // wanted byte is in buffer so only skip
  5539. inc(src^.pub.next_input_byte, num_bytes);
  5540. dec(src^.pub.bytes_in_buffer, num_bytes);
  5541. end;
  5542. end;
  5543. end;
  5544. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5545. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5546. var
  5547. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5548. begin
  5549. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5550. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5551. // write complete buffer
  5552. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5553. // reset buffer
  5554. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5555. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5556. end;
  5557. result := true;
  5558. end;
  5559. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5560. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5561. var
  5562. Idx: Integer;
  5563. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5564. begin
  5565. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5566. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5567. // check for endblock
  5568. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5569. // write endblock
  5570. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5571. // leave
  5572. break;
  5573. end else
  5574. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5575. end;
  5576. end;
  5577. {$ENDIF}
  5578. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5579. {$IF DEFINED(GLB_LAZ_JPEG)}
  5580. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5581. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5582. const
  5583. MAGIC_LEN = 2;
  5584. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  5585. var
  5586. intf: TLazIntfImage;
  5587. reader: TFPReaderJPEG;
  5588. StreamPos: Int64;
  5589. magic: String[MAGIC_LEN];
  5590. begin
  5591. result := true;
  5592. StreamPos := aStream.Position;
  5593. SetLength(magic, MAGIC_LEN);
  5594. aStream.Read(magic[1], MAGIC_LEN);
  5595. aStream.Position := StreamPos;
  5596. if (magic <> JPEG_MAGIC) then begin
  5597. result := false;
  5598. exit;
  5599. end;
  5600. reader := TFPReaderJPEG.Create;
  5601. intf := TLazIntfImage.Create(0, 0);
  5602. try try
  5603. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  5604. reader.ImageRead(aStream, intf);
  5605. AssignFromLazIntfImage(intf);
  5606. except
  5607. result := false;
  5608. aStream.Position := StreamPos;
  5609. exit;
  5610. end;
  5611. finally
  5612. reader.Free;
  5613. intf.Free;
  5614. end;
  5615. end;
  5616. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5617. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5618. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5619. var
  5620. Surface: PSDL_Surface;
  5621. RWops: PSDL_RWops;
  5622. begin
  5623. result := false;
  5624. RWops := glBitmapCreateRWops(aStream);
  5625. try
  5626. if IMG_isJPG(RWops) > 0 then begin
  5627. Surface := IMG_LoadJPG_RW(RWops);
  5628. try
  5629. AssignFromSurface(Surface);
  5630. result := true;
  5631. finally
  5632. SDL_FreeSurface(Surface);
  5633. end;
  5634. end;
  5635. finally
  5636. SDL_FreeRW(RWops);
  5637. end;
  5638. end;
  5639. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5640. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5641. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5642. var
  5643. StreamPos: Int64;
  5644. Temp: array[0..1]of Byte;
  5645. jpeg: jpeg_decompress_struct;
  5646. jpeg_err: jpeg_error_mgr;
  5647. IntFormat: TglBitmapFormat;
  5648. pImage: pByte;
  5649. TempHeight, TempWidth: Integer;
  5650. pTemp: pByte;
  5651. Row: Integer;
  5652. FormatDesc: TFormatDescriptor;
  5653. begin
  5654. result := false;
  5655. if not init_libJPEG then
  5656. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5657. try
  5658. // reading first two bytes to test file and set cursor back to begin
  5659. StreamPos := aStream.Position;
  5660. aStream.Read({%H-}Temp[0], 2);
  5661. aStream.Position := StreamPos;
  5662. // if Bitmap then read file.
  5663. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5664. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5665. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5666. // error managment
  5667. jpeg.err := jpeg_std_error(@jpeg_err);
  5668. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5669. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5670. // decompression struct
  5671. jpeg_create_decompress(@jpeg);
  5672. // allocation space for streaming methods
  5673. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5674. // seeting up custom functions
  5675. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5676. pub.init_source := glBitmap_libJPEG_init_source;
  5677. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5678. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5679. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5680. pub.term_source := glBitmap_libJPEG_term_source;
  5681. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5682. pub.next_input_byte := nil; // until buffer loaded
  5683. SrcStream := aStream;
  5684. end;
  5685. // set global decoding state
  5686. jpeg.global_state := DSTATE_START;
  5687. // read header of jpeg
  5688. jpeg_read_header(@jpeg, false);
  5689. // setting output parameter
  5690. case jpeg.jpeg_color_space of
  5691. JCS_GRAYSCALE:
  5692. begin
  5693. jpeg.out_color_space := JCS_GRAYSCALE;
  5694. IntFormat := tfLuminance8;
  5695. end;
  5696. else
  5697. jpeg.out_color_space := JCS_RGB;
  5698. IntFormat := tfRGB8;
  5699. end;
  5700. // reading image
  5701. jpeg_start_decompress(@jpeg);
  5702. TempHeight := jpeg.output_height;
  5703. TempWidth := jpeg.output_width;
  5704. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5705. // creating new image
  5706. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5707. try
  5708. pTemp := pImage;
  5709. for Row := 0 to TempHeight -1 do begin
  5710. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5711. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5712. end;
  5713. // finish decompression
  5714. jpeg_finish_decompress(@jpeg);
  5715. // destroy decompression
  5716. jpeg_destroy_decompress(@jpeg);
  5717. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5718. result := true;
  5719. except
  5720. if Assigned(pImage) then
  5721. FreeMem(pImage);
  5722. raise;
  5723. end;
  5724. end;
  5725. finally
  5726. quit_libJPEG;
  5727. end;
  5728. end;
  5729. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5730. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5731. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5732. var
  5733. bmp: TBitmap;
  5734. jpg: TJPEGImage;
  5735. StreamPos: Int64;
  5736. Temp: array[0..1]of Byte;
  5737. begin
  5738. result := false;
  5739. // reading first two bytes to test file and set cursor back to begin
  5740. StreamPos := aStream.Position;
  5741. aStream.Read(Temp[0], 2);
  5742. aStream.Position := StreamPos;
  5743. // if Bitmap then read file.
  5744. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5745. bmp := TBitmap.Create;
  5746. try
  5747. jpg := TJPEGImage.Create;
  5748. try
  5749. jpg.LoadFromStream(aStream);
  5750. bmp.Assign(jpg);
  5751. result := AssignFromBitmap(bmp);
  5752. finally
  5753. jpg.Free;
  5754. end;
  5755. finally
  5756. bmp.Free;
  5757. end;
  5758. end;
  5759. end;
  5760. {$IFEND}
  5761. {$ENDIF}
  5762. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5763. {$IF DEFINED(GLB_LAZ_JPEG)}
  5764. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5765. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5766. var
  5767. jpeg: TJPEGImage;
  5768. intf: TLazIntfImage;
  5769. raw: TRawImage;
  5770. begin
  5771. jpeg := TJPEGImage.Create;
  5772. intf := TLazIntfImage.Create(0, 0);
  5773. try
  5774. if not AssignToLazIntfImage(intf) then
  5775. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5776. intf.GetRawImage(raw);
  5777. jpeg.LoadFromRawImage(raw, false);
  5778. jpeg.SaveToStream(aStream);
  5779. finally
  5780. intf.Free;
  5781. jpeg.Free;
  5782. end;
  5783. end;
  5784. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5785. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5786. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5787. var
  5788. jpeg: jpeg_compress_struct;
  5789. jpeg_err: jpeg_error_mgr;
  5790. Row: Integer;
  5791. pTemp, pTemp2: pByte;
  5792. procedure CopyRow(pDest, pSource: pByte);
  5793. var
  5794. X: Integer;
  5795. begin
  5796. for X := 0 to Width - 1 do begin
  5797. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5798. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5799. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5800. Inc(pDest, 3);
  5801. Inc(pSource, 3);
  5802. end;
  5803. end;
  5804. begin
  5805. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5806. raise EglBitmapUnsupportedFormat.Create(Format);
  5807. if not init_libJPEG then
  5808. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5809. try
  5810. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  5811. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5812. // error managment
  5813. jpeg.err := jpeg_std_error(@jpeg_err);
  5814. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5815. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5816. // compression struct
  5817. jpeg_create_compress(@jpeg);
  5818. // allocation space for streaming methods
  5819. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5820. // seeting up custom functions
  5821. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5822. pub.init_destination := glBitmap_libJPEG_init_destination;
  5823. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5824. pub.term_destination := glBitmap_libJPEG_term_destination;
  5825. pub.next_output_byte := @DestBuffer[1];
  5826. pub.free_in_buffer := Length(DestBuffer);
  5827. DestStream := aStream;
  5828. end;
  5829. // very important state
  5830. jpeg.global_state := CSTATE_START;
  5831. jpeg.image_width := Width;
  5832. jpeg.image_height := Height;
  5833. case Format of
  5834. tfAlpha8, tfLuminance8: begin
  5835. jpeg.input_components := 1;
  5836. jpeg.in_color_space := JCS_GRAYSCALE;
  5837. end;
  5838. tfRGB8, tfBGR8: begin
  5839. jpeg.input_components := 3;
  5840. jpeg.in_color_space := JCS_RGB;
  5841. end;
  5842. end;
  5843. jpeg_set_defaults(@jpeg);
  5844. jpeg_set_quality(@jpeg, 95, true);
  5845. jpeg_start_compress(@jpeg, true);
  5846. pTemp := Data;
  5847. if Format = tfBGR8 then
  5848. GetMem(pTemp2, fRowSize)
  5849. else
  5850. pTemp2 := pTemp;
  5851. try
  5852. for Row := 0 to jpeg.image_height -1 do begin
  5853. // prepare row
  5854. if Format = tfBGR8 then
  5855. CopyRow(pTemp2, pTemp)
  5856. else
  5857. pTemp2 := pTemp;
  5858. // write row
  5859. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5860. inc(pTemp, fRowSize);
  5861. end;
  5862. finally
  5863. // free memory
  5864. if Format = tfBGR8 then
  5865. FreeMem(pTemp2);
  5866. end;
  5867. jpeg_finish_compress(@jpeg);
  5868. jpeg_destroy_compress(@jpeg);
  5869. finally
  5870. quit_libJPEG;
  5871. end;
  5872. end;
  5873. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5874. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5875. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5876. var
  5877. Bmp: TBitmap;
  5878. Jpg: TJPEGImage;
  5879. begin
  5880. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5881. raise EglBitmapUnsupportedFormat.Create(Format);
  5882. Bmp := TBitmap.Create;
  5883. try
  5884. Jpg := TJPEGImage.Create;
  5885. try
  5886. AssignToBitmap(Bmp);
  5887. if (Format in [tfAlpha8, tfLuminance8]) then begin
  5888. Jpg.Grayscale := true;
  5889. Jpg.PixelFormat := jf8Bit;
  5890. end;
  5891. Jpg.Assign(Bmp);
  5892. Jpg.SaveToStream(aStream);
  5893. finally
  5894. FreeAndNil(Jpg);
  5895. end;
  5896. finally
  5897. FreeAndNil(Bmp);
  5898. end;
  5899. end;
  5900. {$IFEND}
  5901. {$ENDIF}
  5902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5903. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5904. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5905. const
  5906. BMP_MAGIC = $4D42;
  5907. BMP_COMP_RGB = 0;
  5908. BMP_COMP_RLE8 = 1;
  5909. BMP_COMP_RLE4 = 2;
  5910. BMP_COMP_BITFIELDS = 3;
  5911. type
  5912. TBMPHeader = packed record
  5913. bfType: Word;
  5914. bfSize: Cardinal;
  5915. bfReserved1: Word;
  5916. bfReserved2: Word;
  5917. bfOffBits: Cardinal;
  5918. end;
  5919. TBMPInfo = packed record
  5920. biSize: Cardinal;
  5921. biWidth: Longint;
  5922. biHeight: Longint;
  5923. biPlanes: Word;
  5924. biBitCount: Word;
  5925. biCompression: Cardinal;
  5926. biSizeImage: Cardinal;
  5927. biXPelsPerMeter: Longint;
  5928. biYPelsPerMeter: Longint;
  5929. biClrUsed: Cardinal;
  5930. biClrImportant: Cardinal;
  5931. end;
  5932. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5933. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5934. //////////////////////////////////////////////////////////////////////////////////////////////////
  5935. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5936. begin
  5937. result := tfEmpty;
  5938. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5939. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5940. //Read Compression
  5941. case aInfo.biCompression of
  5942. BMP_COMP_RLE4,
  5943. BMP_COMP_RLE8: begin
  5944. raise EglBitmap.Create('RLE compression is not supported');
  5945. end;
  5946. BMP_COMP_BITFIELDS: begin
  5947. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5948. aStream.Read(aMask.r, SizeOf(aMask.r));
  5949. aStream.Read(aMask.g, SizeOf(aMask.g));
  5950. aStream.Read(aMask.b, SizeOf(aMask.b));
  5951. aStream.Read(aMask.a, SizeOf(aMask.a));
  5952. end else
  5953. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  5954. end;
  5955. end;
  5956. //get suitable format
  5957. case aInfo.biBitCount of
  5958. 8: result := tfLuminance8;
  5959. 16: result := tfBGR5;
  5960. 24: result := tfBGR8;
  5961. 32: result := tfBGRA8;
  5962. end;
  5963. end;
  5964. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5965. var
  5966. i, c: Integer;
  5967. ColorTable: TbmpColorTable;
  5968. begin
  5969. result := nil;
  5970. if (aInfo.biBitCount >= 16) then
  5971. exit;
  5972. aFormat := tfLuminance8;
  5973. c := aInfo.biClrUsed;
  5974. if (c = 0) then
  5975. c := 1 shl aInfo.biBitCount;
  5976. SetLength(ColorTable, c);
  5977. for i := 0 to c-1 do begin
  5978. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5979. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5980. aFormat := tfRGB8;
  5981. end;
  5982. result := TbmpColorTableFormat.Create;
  5983. result.PixelSize := aInfo.biBitCount / 8;
  5984. result.ColorTable := ColorTable;
  5985. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5986. end;
  5987. //////////////////////////////////////////////////////////////////////////////////////////////////
  5988. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5989. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5990. var
  5991. TmpFormat: TglBitmapFormat;
  5992. FormatDesc: TFormatDescriptor;
  5993. begin
  5994. result := nil;
  5995. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5996. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5997. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5998. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5999. aFormat := FormatDesc.Format;
  6000. exit;
  6001. end;
  6002. end;
  6003. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  6004. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  6005. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  6006. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  6007. result := TbmpBitfieldFormat.Create;
  6008. result.PixelSize := aInfo.biBitCount / 8;
  6009. result.RedMask := aMask.r;
  6010. result.GreenMask := aMask.g;
  6011. result.BlueMask := aMask.b;
  6012. result.AlphaMask := aMask.a;
  6013. end;
  6014. end;
  6015. var
  6016. //simple types
  6017. StartPos: Int64;
  6018. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  6019. PaddingBuff: Cardinal;
  6020. LineBuf, ImageData, TmpData: PByte;
  6021. SourceMD, DestMD: Pointer;
  6022. BmpFormat: TglBitmapFormat;
  6023. //records
  6024. Mask: TglBitmapColorRec;
  6025. Header: TBMPHeader;
  6026. Info: TBMPInfo;
  6027. //classes
  6028. SpecialFormat: TFormatDescriptor;
  6029. FormatDesc: TFormatDescriptor;
  6030. //////////////////////////////////////////////////////////////////////////////////////////////////
  6031. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  6032. var
  6033. i: Integer;
  6034. Pixel: TglBitmapPixelData;
  6035. begin
  6036. aStream.Read(aLineBuf^, rbLineSize);
  6037. SpecialFormat.PreparePixel(Pixel);
  6038. for i := 0 to Info.biWidth-1 do begin
  6039. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  6040. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  6041. FormatDesc.Map(Pixel, aData, DestMD);
  6042. end;
  6043. end;
  6044. begin
  6045. result := false;
  6046. BmpFormat := tfEmpty;
  6047. SpecialFormat := nil;
  6048. LineBuf := nil;
  6049. SourceMD := nil;
  6050. DestMD := nil;
  6051. // Header
  6052. StartPos := aStream.Position;
  6053. aStream.Read(Header{%H-}, SizeOf(Header));
  6054. if Header.bfType = BMP_MAGIC then begin
  6055. try try
  6056. BmpFormat := ReadInfo(Info, Mask);
  6057. SpecialFormat := ReadColorTable(BmpFormat, Info);
  6058. if not Assigned(SpecialFormat) then
  6059. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  6060. aStream.Position := StartPos + Header.bfOffBits;
  6061. if (BmpFormat <> tfEmpty) then begin
  6062. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  6063. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  6064. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  6065. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  6066. //get Memory
  6067. DestMD := FormatDesc.CreateMappingData;
  6068. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  6069. GetMem(ImageData, ImageSize);
  6070. if Assigned(SpecialFormat) then begin
  6071. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  6072. SourceMD := SpecialFormat.CreateMappingData;
  6073. end;
  6074. //read Data
  6075. try try
  6076. FillChar(ImageData^, ImageSize, $FF);
  6077. TmpData := ImageData;
  6078. if (Info.biHeight > 0) then
  6079. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  6080. for i := 0 to Abs(Info.biHeight)-1 do begin
  6081. if Assigned(SpecialFormat) then
  6082. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  6083. else
  6084. aStream.Read(TmpData^, wbLineSize); //else only read data
  6085. if (Info.biHeight > 0) then
  6086. dec(TmpData, wbLineSize)
  6087. else
  6088. inc(TmpData, wbLineSize);
  6089. aStream.Read(PaddingBuff{%H-}, Padding);
  6090. end;
  6091. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6092. result := true;
  6093. finally
  6094. if Assigned(LineBuf) then
  6095. FreeMem(LineBuf);
  6096. if Assigned(SourceMD) then
  6097. SpecialFormat.FreeMappingData(SourceMD);
  6098. FormatDesc.FreeMappingData(DestMD);
  6099. end;
  6100. except
  6101. if Assigned(ImageData) then
  6102. FreeMem(ImageData);
  6103. raise;
  6104. end;
  6105. end else
  6106. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6107. except
  6108. aStream.Position := StartPos;
  6109. raise;
  6110. end;
  6111. finally
  6112. FreeAndNil(SpecialFormat);
  6113. end;
  6114. end
  6115. else aStream.Position := StartPos;
  6116. end;
  6117. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6118. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6119. var
  6120. Header: TBMPHeader;
  6121. Info: TBMPInfo;
  6122. Converter: TFormatDescriptor;
  6123. FormatDesc: TFormatDescriptor;
  6124. SourceFD, DestFD: Pointer;
  6125. pData, srcData, dstData, ConvertBuffer: pByte;
  6126. Pixel: TglBitmapPixelData;
  6127. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6128. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6129. PaddingBuff: Cardinal;
  6130. function GetLineWidth : Integer;
  6131. begin
  6132. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6133. end;
  6134. begin
  6135. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6136. raise EglBitmapUnsupportedFormat.Create(Format);
  6137. Converter := nil;
  6138. FormatDesc := TFormatDescriptor.Get(Format);
  6139. ImageSize := FormatDesc.GetSize(Dimension);
  6140. FillChar(Header{%H-}, SizeOf(Header), 0);
  6141. Header.bfType := BMP_MAGIC;
  6142. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6143. Header.bfReserved1 := 0;
  6144. Header.bfReserved2 := 0;
  6145. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6146. FillChar(Info{%H-}, SizeOf(Info), 0);
  6147. Info.biSize := SizeOf(Info);
  6148. Info.biWidth := Width;
  6149. Info.biHeight := Height;
  6150. Info.biPlanes := 1;
  6151. Info.biCompression := BMP_COMP_RGB;
  6152. Info.biSizeImage := ImageSize;
  6153. try
  6154. case Format of
  6155. tfLuminance4: begin
  6156. Info.biBitCount := 4;
  6157. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  6158. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  6159. Converter := TbmpColorTableFormat.Create;
  6160. with (Converter as TbmpColorTableFormat) do begin
  6161. PixelSize := 0.5;
  6162. Format := Format;
  6163. Range := glBitmapColorRec($F, $F, $F, $0);
  6164. CreateColorTable;
  6165. end;
  6166. end;
  6167. tfR3G3B2, tfLuminance8: begin
  6168. Info.biBitCount := 8;
  6169. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6170. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6171. Converter := TbmpColorTableFormat.Create;
  6172. with (Converter as TbmpColorTableFormat) do begin
  6173. PixelSize := 1;
  6174. Format := Format;
  6175. if (Format = tfR3G3B2) then begin
  6176. Range := glBitmapColorRec($7, $7, $3, $0);
  6177. Shift := glBitmapShiftRec(0, 3, 6, 0);
  6178. end else
  6179. Range := glBitmapColorRec($FF, $FF, $FF, $0);
  6180. CreateColorTable;
  6181. end;
  6182. end;
  6183. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  6184. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  6185. Info.biBitCount := 16;
  6186. Info.biCompression := BMP_COMP_BITFIELDS;
  6187. end;
  6188. tfBGR8, tfRGB8: begin
  6189. Info.biBitCount := 24;
  6190. if (Format = tfRGB8) then
  6191. Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6192. end;
  6193. tfRGB10, tfRGB10A2, tfRGBA8,
  6194. tfBGR10, tfBGR10A2, tfBGRA8: begin
  6195. Info.biBitCount := 32;
  6196. Info.biCompression := BMP_COMP_BITFIELDS;
  6197. end;
  6198. else
  6199. raise EglBitmapUnsupportedFormat.Create(Format);
  6200. end;
  6201. Info.biXPelsPerMeter := 2835;
  6202. Info.biYPelsPerMeter := 2835;
  6203. // prepare bitmasks
  6204. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6205. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6206. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6207. RedMask := FormatDesc.RedMask;
  6208. GreenMask := FormatDesc.GreenMask;
  6209. BlueMask := FormatDesc.BlueMask;
  6210. AlphaMask := FormatDesc.AlphaMask;
  6211. end;
  6212. // headers
  6213. aStream.Write(Header, SizeOf(Header));
  6214. aStream.Write(Info, SizeOf(Info));
  6215. // colortable
  6216. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6217. with (Converter as TbmpColorTableFormat) do
  6218. aStream.Write(ColorTable[0].b,
  6219. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6220. // bitmasks
  6221. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6222. aStream.Write(RedMask, SizeOf(Cardinal));
  6223. aStream.Write(GreenMask, SizeOf(Cardinal));
  6224. aStream.Write(BlueMask, SizeOf(Cardinal));
  6225. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6226. end;
  6227. // image data
  6228. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  6229. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6230. Padding := GetLineWidth - wbLineSize;
  6231. PaddingBuff := 0;
  6232. pData := Data;
  6233. inc(pData, (Height-1) * rbLineSize);
  6234. // prepare row buffer. But only for RGB because RGBA supports color masks
  6235. // so it's possible to change color within the image.
  6236. if Assigned(Converter) then begin
  6237. FormatDesc.PreparePixel(Pixel);
  6238. GetMem(ConvertBuffer, wbLineSize);
  6239. SourceFD := FormatDesc.CreateMappingData;
  6240. DestFD := Converter.CreateMappingData;
  6241. end else
  6242. ConvertBuffer := nil;
  6243. try
  6244. for LineIdx := 0 to Height - 1 do begin
  6245. // preparing row
  6246. if Assigned(Converter) then begin
  6247. srcData := pData;
  6248. dstData := ConvertBuffer;
  6249. for PixelIdx := 0 to Info.biWidth-1 do begin
  6250. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6251. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6252. Converter.Map(Pixel, dstData, DestFD);
  6253. end;
  6254. aStream.Write(ConvertBuffer^, wbLineSize);
  6255. end else begin
  6256. aStream.Write(pData^, rbLineSize);
  6257. end;
  6258. dec(pData, rbLineSize);
  6259. if (Padding > 0) then
  6260. aStream.Write(PaddingBuff, Padding);
  6261. end;
  6262. finally
  6263. // destroy row buffer
  6264. if Assigned(ConvertBuffer) then begin
  6265. FormatDesc.FreeMappingData(SourceFD);
  6266. Converter.FreeMappingData(DestFD);
  6267. FreeMem(ConvertBuffer);
  6268. end;
  6269. end;
  6270. finally
  6271. if Assigned(Converter) then
  6272. Converter.Free;
  6273. end;
  6274. end;
  6275. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6276. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6277. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6278. type
  6279. TTGAHeader = packed record
  6280. ImageID: Byte;
  6281. ColorMapType: Byte;
  6282. ImageType: Byte;
  6283. //ColorMapSpec: Array[0..4] of Byte;
  6284. ColorMapStart: Word;
  6285. ColorMapLength: Word;
  6286. ColorMapEntrySize: Byte;
  6287. OrigX: Word;
  6288. OrigY: Word;
  6289. Width: Word;
  6290. Height: Word;
  6291. Bpp: Byte;
  6292. ImageDesc: Byte;
  6293. end;
  6294. const
  6295. TGA_UNCOMPRESSED_RGB = 2;
  6296. TGA_UNCOMPRESSED_GRAY = 3;
  6297. TGA_COMPRESSED_RGB = 10;
  6298. TGA_COMPRESSED_GRAY = 11;
  6299. TGA_NONE_COLOR_TABLE = 0;
  6300. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6301. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6302. var
  6303. Header: TTGAHeader;
  6304. ImageData: System.PByte;
  6305. StartPosition: Int64;
  6306. PixelSize, LineSize: Integer;
  6307. tgaFormat: TglBitmapFormat;
  6308. FormatDesc: TFormatDescriptor;
  6309. Counter: packed record
  6310. X, Y: packed record
  6311. low, high, dir: Integer;
  6312. end;
  6313. end;
  6314. const
  6315. CACHE_SIZE = $4000;
  6316. ////////////////////////////////////////////////////////////////////////////////////////
  6317. procedure ReadUncompressed;
  6318. var
  6319. i, j: Integer;
  6320. buf, tmp1, tmp2: System.PByte;
  6321. begin
  6322. buf := nil;
  6323. if (Counter.X.dir < 0) then
  6324. GetMem(buf, LineSize);
  6325. try
  6326. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6327. tmp1 := ImageData;
  6328. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6329. if (Counter.X.dir < 0) then begin //flip X
  6330. aStream.Read(buf^, LineSize);
  6331. tmp2 := buf;
  6332. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6333. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6334. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6335. tmp1^ := tmp2^;
  6336. inc(tmp1);
  6337. inc(tmp2);
  6338. end;
  6339. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6340. end;
  6341. end else
  6342. aStream.Read(tmp1^, LineSize);
  6343. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6344. end;
  6345. finally
  6346. if Assigned(buf) then
  6347. FreeMem(buf);
  6348. end;
  6349. end;
  6350. ////////////////////////////////////////////////////////////////////////////////////////
  6351. procedure ReadCompressed;
  6352. /////////////////////////////////////////////////////////////////
  6353. var
  6354. TmpData: System.PByte;
  6355. LinePixelsRead: Integer;
  6356. procedure CheckLine;
  6357. begin
  6358. if (LinePixelsRead >= Header.Width) then begin
  6359. LinePixelsRead := 0;
  6360. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6361. TmpData := ImageData;
  6362. inc(TmpData, Counter.Y.low * LineSize); //set line
  6363. if (Counter.X.dir < 0) then //if x flipped then
  6364. inc(TmpData, LineSize - PixelSize); //set last pixel
  6365. end;
  6366. end;
  6367. /////////////////////////////////////////////////////////////////
  6368. var
  6369. Cache: PByte;
  6370. CacheSize, CachePos: Integer;
  6371. procedure CachedRead(out Buffer; Count: Integer);
  6372. var
  6373. BytesRead: Integer;
  6374. begin
  6375. if (CachePos + Count > CacheSize) then begin
  6376. //if buffer overflow save non read bytes
  6377. BytesRead := 0;
  6378. if (CacheSize - CachePos > 0) then begin
  6379. BytesRead := CacheSize - CachePos;
  6380. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6381. inc(CachePos, BytesRead);
  6382. end;
  6383. //load cache from file
  6384. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6385. aStream.Read(Cache^, CacheSize);
  6386. CachePos := 0;
  6387. //read rest of requested bytes
  6388. if (Count - BytesRead > 0) then begin
  6389. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6390. inc(CachePos, Count - BytesRead);
  6391. end;
  6392. end else begin
  6393. //if no buffer overflow just read the data
  6394. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6395. inc(CachePos, Count);
  6396. end;
  6397. end;
  6398. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6399. begin
  6400. case PixelSize of
  6401. 1: begin
  6402. aBuffer^ := aData^;
  6403. inc(aBuffer, Counter.X.dir);
  6404. end;
  6405. 2: begin
  6406. PWord(aBuffer)^ := PWord(aData)^;
  6407. inc(aBuffer, 2 * Counter.X.dir);
  6408. end;
  6409. 3: begin
  6410. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6411. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6412. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6413. inc(aBuffer, 3 * Counter.X.dir);
  6414. end;
  6415. 4: begin
  6416. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6417. inc(aBuffer, 4 * Counter.X.dir);
  6418. end;
  6419. end;
  6420. end;
  6421. var
  6422. TotalPixelsToRead, TotalPixelsRead: Integer;
  6423. Temp: Byte;
  6424. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6425. PixelRepeat: Boolean;
  6426. PixelsToRead, PixelCount: Integer;
  6427. begin
  6428. CacheSize := 0;
  6429. CachePos := 0;
  6430. TotalPixelsToRead := Header.Width * Header.Height;
  6431. TotalPixelsRead := 0;
  6432. LinePixelsRead := 0;
  6433. GetMem(Cache, CACHE_SIZE);
  6434. try
  6435. TmpData := ImageData;
  6436. inc(TmpData, Counter.Y.low * LineSize); //set line
  6437. if (Counter.X.dir < 0) then //if x flipped then
  6438. inc(TmpData, LineSize - PixelSize); //set last pixel
  6439. repeat
  6440. //read CommandByte
  6441. CachedRead(Temp, 1);
  6442. PixelRepeat := (Temp and $80) > 0;
  6443. PixelsToRead := (Temp and $7F) + 1;
  6444. inc(TotalPixelsRead, PixelsToRead);
  6445. if PixelRepeat then
  6446. CachedRead(buf[0], PixelSize);
  6447. while (PixelsToRead > 0) do begin
  6448. CheckLine;
  6449. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6450. while (PixelCount > 0) do begin
  6451. if not PixelRepeat then
  6452. CachedRead(buf[0], PixelSize);
  6453. PixelToBuffer(@buf[0], TmpData);
  6454. inc(LinePixelsRead);
  6455. dec(PixelsToRead);
  6456. dec(PixelCount);
  6457. end;
  6458. end;
  6459. until (TotalPixelsRead >= TotalPixelsToRead);
  6460. finally
  6461. FreeMem(Cache);
  6462. end;
  6463. end;
  6464. function IsGrayFormat: Boolean;
  6465. begin
  6466. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6467. end;
  6468. begin
  6469. result := false;
  6470. // reading header to test file and set cursor back to begin
  6471. StartPosition := aStream.Position;
  6472. aStream.Read(Header{%H-}, SizeOf(Header));
  6473. // no colormapped files
  6474. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6475. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6476. begin
  6477. try
  6478. if Header.ImageID <> 0 then // skip image ID
  6479. aStream.Position := aStream.Position + Header.ImageID;
  6480. tgaFormat := tfEmpty;
  6481. case Header.Bpp of
  6482. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6483. 0: tgaFormat := tfLuminance8;
  6484. 8: tgaFormat := tfAlpha8;
  6485. end;
  6486. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6487. 0: tgaFormat := tfLuminance16;
  6488. 8: tgaFormat := tfLuminance8Alpha8;
  6489. end else case (Header.ImageDesc and $F) of
  6490. 0: tgaFormat := tfBGR5;
  6491. 1: tgaFormat := tfBGR5A1;
  6492. 4: tgaFormat := tfBGRA4;
  6493. end;
  6494. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6495. 0: tgaFormat := tfBGR8;
  6496. end;
  6497. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6498. 2: tgaFormat := tfBGR10A2;
  6499. 8: tgaFormat := tfBGRA8;
  6500. end;
  6501. end;
  6502. if (tgaFormat = tfEmpty) then
  6503. raise EglBitmap.Create('LoadTga - unsupported format');
  6504. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6505. PixelSize := FormatDesc.GetSize(1, 1);
  6506. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6507. GetMem(ImageData, LineSize * Header.Height);
  6508. try
  6509. //column direction
  6510. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6511. Counter.X.low := Header.Height-1;;
  6512. Counter.X.high := 0;
  6513. Counter.X.dir := -1;
  6514. end else begin
  6515. Counter.X.low := 0;
  6516. Counter.X.high := Header.Height-1;
  6517. Counter.X.dir := 1;
  6518. end;
  6519. // Row direction
  6520. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6521. Counter.Y.low := 0;
  6522. Counter.Y.high := Header.Height-1;
  6523. Counter.Y.dir := 1;
  6524. end else begin
  6525. Counter.Y.low := Header.Height-1;;
  6526. Counter.Y.high := 0;
  6527. Counter.Y.dir := -1;
  6528. end;
  6529. // Read Image
  6530. case Header.ImageType of
  6531. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6532. ReadUncompressed;
  6533. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6534. ReadCompressed;
  6535. end;
  6536. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6537. result := true;
  6538. except
  6539. if Assigned(ImageData) then
  6540. FreeMem(ImageData);
  6541. raise;
  6542. end;
  6543. finally
  6544. aStream.Position := StartPosition;
  6545. end;
  6546. end
  6547. else aStream.Position := StartPosition;
  6548. end;
  6549. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6550. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6551. var
  6552. Header: TTGAHeader;
  6553. LineSize, Size, x, y: Integer;
  6554. Pixel: TglBitmapPixelData;
  6555. LineBuf, SourceData, DestData: PByte;
  6556. SourceMD, DestMD: Pointer;
  6557. FormatDesc: TFormatDescriptor;
  6558. Converter: TFormatDescriptor;
  6559. begin
  6560. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6561. raise EglBitmapUnsupportedFormat.Create(Format);
  6562. //prepare header
  6563. FillChar(Header{%H-}, SizeOf(Header), 0);
  6564. //set ImageType
  6565. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6566. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6567. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6568. else
  6569. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6570. //set BitsPerPixel
  6571. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6572. Header.Bpp := 8
  6573. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6574. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6575. Header.Bpp := 16
  6576. else if (Format in [tfBGR8, tfRGB8]) then
  6577. Header.Bpp := 24
  6578. else
  6579. Header.Bpp := 32;
  6580. //set AlphaBitCount
  6581. case Format of
  6582. tfRGB5A1, tfBGR5A1:
  6583. Header.ImageDesc := 1 and $F;
  6584. tfRGB10A2, tfBGR10A2:
  6585. Header.ImageDesc := 2 and $F;
  6586. tfRGBA4, tfBGRA4:
  6587. Header.ImageDesc := 4 and $F;
  6588. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6589. Header.ImageDesc := 8 and $F;
  6590. end;
  6591. Header.Width := Width;
  6592. Header.Height := Height;
  6593. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6594. aStream.Write(Header, SizeOf(Header));
  6595. // convert RGB(A) to BGR(A)
  6596. Converter := nil;
  6597. FormatDesc := TFormatDescriptor.Get(Format);
  6598. Size := FormatDesc.GetSize(Dimension);
  6599. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6600. if (FormatDesc.RGBInverted = tfEmpty) then
  6601. raise EglBitmap.Create('inverted RGB format is empty');
  6602. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6603. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6604. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6605. raise EglBitmap.Create('invalid inverted RGB format');
  6606. end;
  6607. if Assigned(Converter) then begin
  6608. LineSize := FormatDesc.GetSize(Width, 1);
  6609. GetMem(LineBuf, LineSize);
  6610. SourceMD := FormatDesc.CreateMappingData;
  6611. DestMD := Converter.CreateMappingData;
  6612. try
  6613. SourceData := Data;
  6614. for y := 0 to Height-1 do begin
  6615. DestData := LineBuf;
  6616. for x := 0 to Width-1 do begin
  6617. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6618. Converter.Map(Pixel, DestData, DestMD);
  6619. end;
  6620. aStream.Write(LineBuf^, LineSize);
  6621. end;
  6622. finally
  6623. FreeMem(LineBuf);
  6624. FormatDesc.FreeMappingData(SourceMD);
  6625. FormatDesc.FreeMappingData(DestMD);
  6626. end;
  6627. end else
  6628. aStream.Write(Data^, Size);
  6629. end;
  6630. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6631. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6632. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6633. const
  6634. DDS_MAGIC: Cardinal = $20534444;
  6635. // DDS_header.dwFlags
  6636. DDSD_CAPS = $00000001;
  6637. DDSD_HEIGHT = $00000002;
  6638. DDSD_WIDTH = $00000004;
  6639. DDSD_PIXELFORMAT = $00001000;
  6640. // DDS_header.sPixelFormat.dwFlags
  6641. DDPF_ALPHAPIXELS = $00000001;
  6642. DDPF_ALPHA = $00000002;
  6643. DDPF_FOURCC = $00000004;
  6644. DDPF_RGB = $00000040;
  6645. DDPF_LUMINANCE = $00020000;
  6646. // DDS_header.sCaps.dwCaps1
  6647. DDSCAPS_TEXTURE = $00001000;
  6648. // DDS_header.sCaps.dwCaps2
  6649. DDSCAPS2_CUBEMAP = $00000200;
  6650. D3DFMT_DXT1 = $31545844;
  6651. D3DFMT_DXT3 = $33545844;
  6652. D3DFMT_DXT5 = $35545844;
  6653. type
  6654. TDDSPixelFormat = packed record
  6655. dwSize: Cardinal;
  6656. dwFlags: Cardinal;
  6657. dwFourCC: Cardinal;
  6658. dwRGBBitCount: Cardinal;
  6659. dwRBitMask: Cardinal;
  6660. dwGBitMask: Cardinal;
  6661. dwBBitMask: Cardinal;
  6662. dwABitMask: Cardinal;
  6663. end;
  6664. TDDSCaps = packed record
  6665. dwCaps1: Cardinal;
  6666. dwCaps2: Cardinal;
  6667. dwDDSX: Cardinal;
  6668. dwReserved: Cardinal;
  6669. end;
  6670. TDDSHeader = packed record
  6671. dwSize: Cardinal;
  6672. dwFlags: Cardinal;
  6673. dwHeight: Cardinal;
  6674. dwWidth: Cardinal;
  6675. dwPitchOrLinearSize: Cardinal;
  6676. dwDepth: Cardinal;
  6677. dwMipMapCount: Cardinal;
  6678. dwReserved: array[0..10] of Cardinal;
  6679. PixelFormat: TDDSPixelFormat;
  6680. Caps: TDDSCaps;
  6681. dwReserved2: Cardinal;
  6682. end;
  6683. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6684. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6685. var
  6686. Header: TDDSHeader;
  6687. Converter: TbmpBitfieldFormat;
  6688. function GetDDSFormat: TglBitmapFormat;
  6689. var
  6690. fd: TFormatDescriptor;
  6691. i: Integer;
  6692. Range: TglBitmapColorRec;
  6693. match: Boolean;
  6694. begin
  6695. result := tfEmpty;
  6696. with Header.PixelFormat do begin
  6697. // Compresses
  6698. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6699. case Header.PixelFormat.dwFourCC of
  6700. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6701. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6702. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6703. end;
  6704. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6705. //find matching format
  6706. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6707. fd := TFormatDescriptor.Get(result);
  6708. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6709. (8 * fd.PixelSize = dwRGBBitCount) then
  6710. exit;
  6711. end;
  6712. //find format with same Range
  6713. Range.r := dwRBitMask;
  6714. Range.g := dwGBitMask;
  6715. Range.b := dwBBitMask;
  6716. Range.a := dwABitMask;
  6717. for i := 0 to 3 do begin
  6718. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6719. Range.arr[i] := Range.arr[i] shr 1;
  6720. end;
  6721. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6722. fd := TFormatDescriptor.Get(result);
  6723. match := true;
  6724. for i := 0 to 3 do
  6725. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6726. match := false;
  6727. break;
  6728. end;
  6729. if match then
  6730. break;
  6731. end;
  6732. //no format with same range found -> use default
  6733. if (result = tfEmpty) then begin
  6734. if (dwABitMask > 0) then
  6735. result := tfBGRA8
  6736. else
  6737. result := tfBGR8;
  6738. end;
  6739. Converter := TbmpBitfieldFormat.Create;
  6740. Converter.RedMask := dwRBitMask;
  6741. Converter.GreenMask := dwGBitMask;
  6742. Converter.BlueMask := dwBBitMask;
  6743. Converter.AlphaMask := dwABitMask;
  6744. Converter.PixelSize := dwRGBBitCount / 8;
  6745. end;
  6746. end;
  6747. end;
  6748. var
  6749. StreamPos: Int64;
  6750. x, y, LineSize, RowSize, Magic: Cardinal;
  6751. NewImage, TmpData, RowData, SrcData: System.PByte;
  6752. SourceMD, DestMD: Pointer;
  6753. Pixel: TglBitmapPixelData;
  6754. ddsFormat: TglBitmapFormat;
  6755. FormatDesc: TFormatDescriptor;
  6756. begin
  6757. result := false;
  6758. Converter := nil;
  6759. StreamPos := aStream.Position;
  6760. // Magic
  6761. aStream.Read(Magic{%H-}, sizeof(Magic));
  6762. if (Magic <> DDS_MAGIC) then begin
  6763. aStream.Position := StreamPos;
  6764. exit;
  6765. end;
  6766. //Header
  6767. aStream.Read(Header{%H-}, sizeof(Header));
  6768. if (Header.dwSize <> SizeOf(Header)) or
  6769. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6770. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6771. begin
  6772. aStream.Position := StreamPos;
  6773. exit;
  6774. end;
  6775. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6776. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  6777. ddsFormat := GetDDSFormat;
  6778. try
  6779. if (ddsFormat = tfEmpty) then
  6780. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6781. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6782. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6783. GetMem(NewImage, Header.dwHeight * LineSize);
  6784. try
  6785. TmpData := NewImage;
  6786. //Converter needed
  6787. if Assigned(Converter) then begin
  6788. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6789. GetMem(RowData, RowSize);
  6790. SourceMD := Converter.CreateMappingData;
  6791. DestMD := FormatDesc.CreateMappingData;
  6792. try
  6793. for y := 0 to Header.dwHeight-1 do begin
  6794. TmpData := NewImage;
  6795. inc(TmpData, y * LineSize);
  6796. SrcData := RowData;
  6797. aStream.Read(SrcData^, RowSize);
  6798. for x := 0 to Header.dwWidth-1 do begin
  6799. Converter.Unmap(SrcData, Pixel, SourceMD);
  6800. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6801. FormatDesc.Map(Pixel, TmpData, DestMD);
  6802. end;
  6803. end;
  6804. finally
  6805. Converter.FreeMappingData(SourceMD);
  6806. FormatDesc.FreeMappingData(DestMD);
  6807. FreeMem(RowData);
  6808. end;
  6809. end else
  6810. // Compressed
  6811. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6812. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6813. for Y := 0 to Header.dwHeight-1 do begin
  6814. aStream.Read(TmpData^, RowSize);
  6815. Inc(TmpData, LineSize);
  6816. end;
  6817. end else
  6818. // Uncompressed
  6819. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6820. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6821. for Y := 0 to Header.dwHeight-1 do begin
  6822. aStream.Read(TmpData^, RowSize);
  6823. Inc(TmpData, LineSize);
  6824. end;
  6825. end else
  6826. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6827. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  6828. result := true;
  6829. except
  6830. if Assigned(NewImage) then
  6831. FreeMem(NewImage);
  6832. raise;
  6833. end;
  6834. finally
  6835. FreeAndNil(Converter);
  6836. end;
  6837. end;
  6838. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6839. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6840. var
  6841. Header: TDDSHeader;
  6842. FormatDesc: TFormatDescriptor;
  6843. begin
  6844. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6845. raise EglBitmapUnsupportedFormat.Create(Format);
  6846. FormatDesc := TFormatDescriptor.Get(Format);
  6847. // Generell
  6848. FillChar(Header{%H-}, SizeOf(Header), 0);
  6849. Header.dwSize := SizeOf(Header);
  6850. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6851. Header.dwWidth := Max(1, Width);
  6852. Header.dwHeight := Max(1, Height);
  6853. // Caps
  6854. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6855. // Pixelformat
  6856. Header.PixelFormat.dwSize := sizeof(Header);
  6857. if (FormatDesc.IsCompressed) then begin
  6858. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6859. case Format of
  6860. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6861. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6862. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6863. end;
  6864. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6865. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6866. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6867. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6868. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6869. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6870. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6871. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6872. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6873. end else begin
  6874. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6875. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6876. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6877. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6878. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6879. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6880. end;
  6881. if (FormatDesc.HasAlpha) then
  6882. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6883. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6884. aStream.Write(Header, SizeOf(Header));
  6885. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6886. end;
  6887. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6888. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6889. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6890. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6891. const aWidth: Integer; const aHeight: Integer);
  6892. var
  6893. pTemp: pByte;
  6894. Size: Integer;
  6895. begin
  6896. if (aHeight > 1) then begin
  6897. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  6898. GetMem(pTemp, Size);
  6899. try
  6900. Move(aData^, pTemp^, Size);
  6901. FreeMem(aData);
  6902. aData := nil;
  6903. except
  6904. FreeMem(pTemp);
  6905. raise;
  6906. end;
  6907. end else
  6908. pTemp := aData;
  6909. inherited SetDataPointer(pTemp, aFormat, aWidth);
  6910. end;
  6911. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6912. function TglBitmap1D.FlipHorz: Boolean;
  6913. var
  6914. Col: Integer;
  6915. pTempDest, pDest, pSource: PByte;
  6916. begin
  6917. result := inherited FlipHorz;
  6918. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  6919. pSource := Data;
  6920. GetMem(pDest, fRowSize);
  6921. try
  6922. pTempDest := pDest;
  6923. Inc(pTempDest, fRowSize);
  6924. for Col := 0 to Width-1 do begin
  6925. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  6926. Move(pSource^, pTempDest^, fPixelSize);
  6927. Inc(pSource, fPixelSize);
  6928. end;
  6929. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  6930. result := true;
  6931. except
  6932. if Assigned(pDest) then
  6933. FreeMem(pDest);
  6934. raise;
  6935. end;
  6936. end;
  6937. end;
  6938. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6939. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  6940. var
  6941. FormatDesc: TFormatDescriptor;
  6942. begin
  6943. // Upload data
  6944. FormatDesc := TFormatDescriptor.Get(Format);
  6945. if FormatDesc.IsCompressed then begin
  6946. if not Assigned(glCompressedTexImage1D) then
  6947. raise EglBitmap.Create('compressed formats not supported by video adapter');
  6948. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  6949. end else if aBuildWithGlu then
  6950. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6951. else
  6952. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6953. // Free Data
  6954. if (FreeDataAfterGenTexture) then
  6955. FreeData;
  6956. end;
  6957. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6958. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  6959. var
  6960. BuildWithGlu, TexRec: Boolean;
  6961. TexSize: Integer;
  6962. begin
  6963. if Assigned(Data) then begin
  6964. // Check Texture Size
  6965. if (aTestTextureSize) then begin
  6966. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6967. if (Width > TexSize) then
  6968. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6969. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6970. (Target = GL_TEXTURE_RECTANGLE);
  6971. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6972. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6973. end;
  6974. CreateId;
  6975. SetupParameters(BuildWithGlu);
  6976. UploadData(BuildWithGlu);
  6977. glAreTexturesResident(1, @fID, @fIsResident);
  6978. end;
  6979. end;
  6980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6981. procedure TglBitmap1D.AfterConstruction;
  6982. begin
  6983. inherited;
  6984. Target := GL_TEXTURE_1D;
  6985. end;
  6986. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6987. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6988. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6989. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6990. begin
  6991. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6992. result := fLines[aIndex]
  6993. else
  6994. result := nil;
  6995. end;
  6996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6997. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6998. const aWidth: Integer; const aHeight: Integer);
  6999. var
  7000. Idx, LineWidth: Integer;
  7001. begin
  7002. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  7003. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  7004. // Assigning Data
  7005. if Assigned(Data) then begin
  7006. SetLength(fLines, GetHeight);
  7007. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  7008. for Idx := 0 to GetHeight-1 do begin
  7009. fLines[Idx] := Data;
  7010. Inc(fLines[Idx], Idx * LineWidth);
  7011. end;
  7012. end
  7013. else SetLength(fLines, 0);
  7014. end else begin
  7015. SetLength(fLines, 0);
  7016. end;
  7017. end;
  7018. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7019. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  7020. var
  7021. FormatDesc: TFormatDescriptor;
  7022. begin
  7023. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7024. FormatDesc := TFormatDescriptor.Get(Format);
  7025. if FormatDesc.IsCompressed then begin
  7026. if not Assigned(glCompressedTexImage2D) then
  7027. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7028. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  7029. end else if aBuildWithGlu then begin
  7030. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  7031. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7032. end else begin
  7033. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  7034. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7035. end;
  7036. // Freigeben
  7037. if (FreeDataAfterGenTexture) then
  7038. FreeData;
  7039. end;
  7040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7041. procedure TglBitmap2D.AfterConstruction;
  7042. begin
  7043. inherited;
  7044. Target := GL_TEXTURE_2D;
  7045. end;
  7046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7047. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  7048. var
  7049. Temp: pByte;
  7050. Size, w, h: Integer;
  7051. FormatDesc: TFormatDescriptor;
  7052. begin
  7053. FormatDesc := TFormatDescriptor.Get(aFormat);
  7054. if FormatDesc.IsCompressed then
  7055. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7056. w := aRight - aLeft;
  7057. h := aBottom - aTop;
  7058. Size := FormatDesc.GetSize(w, h);
  7059. GetMem(Temp, Size);
  7060. try
  7061. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7062. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7063. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  7064. FlipVert;
  7065. except
  7066. if Assigned(Temp) then
  7067. FreeMem(Temp);
  7068. raise;
  7069. end;
  7070. end;
  7071. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7072. procedure TglBitmap2D.GetDataFromTexture;
  7073. var
  7074. Temp: PByte;
  7075. TempWidth, TempHeight: Integer;
  7076. TempIntFormat: GLint;
  7077. IntFormat: TglBitmapFormat;
  7078. FormatDesc: TFormatDescriptor;
  7079. begin
  7080. Bind;
  7081. // Request Data
  7082. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7083. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7084. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7085. IntFormat := tfEmpty;
  7086. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7087. IntFormat := FormatDesc.Format;
  7088. // Getting data from OpenGL
  7089. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7090. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7091. try
  7092. if FormatDesc.IsCompressed then begin
  7093. if not Assigned(glGetCompressedTexImage) then
  7094. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7095. glGetCompressedTexImage(Target, 0, Temp)
  7096. end else
  7097. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7098. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7099. except
  7100. if Assigned(Temp) then
  7101. FreeMem(Temp);
  7102. raise;
  7103. end;
  7104. end;
  7105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7106. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7107. var
  7108. BuildWithGlu, PotTex, TexRec: Boolean;
  7109. TexSize: Integer;
  7110. begin
  7111. if Assigned(Data) then begin
  7112. // Check Texture Size
  7113. if (aTestTextureSize) then begin
  7114. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7115. if ((Height > TexSize) or (Width > TexSize)) then
  7116. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7117. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7118. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7119. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7120. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7121. end;
  7122. CreateId;
  7123. SetupParameters(BuildWithGlu);
  7124. UploadData(Target, BuildWithGlu);
  7125. glAreTexturesResident(1, @fID, @fIsResident);
  7126. end;
  7127. end;
  7128. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7129. function TglBitmap2D.FlipHorz: Boolean;
  7130. var
  7131. Col, Row: Integer;
  7132. TempDestData, DestData, SourceData: PByte;
  7133. ImgSize: Integer;
  7134. begin
  7135. result := inherited FlipHorz;
  7136. if Assigned(Data) then begin
  7137. SourceData := Data;
  7138. ImgSize := Height * fRowSize;
  7139. GetMem(DestData, ImgSize);
  7140. try
  7141. TempDestData := DestData;
  7142. Dec(TempDestData, fRowSize + fPixelSize);
  7143. for Row := 0 to Height -1 do begin
  7144. Inc(TempDestData, fRowSize * 2);
  7145. for Col := 0 to Width -1 do begin
  7146. Move(SourceData^, TempDestData^, fPixelSize);
  7147. Inc(SourceData, fPixelSize);
  7148. Dec(TempDestData, fPixelSize);
  7149. end;
  7150. end;
  7151. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7152. result := true;
  7153. except
  7154. if Assigned(DestData) then
  7155. FreeMem(DestData);
  7156. raise;
  7157. end;
  7158. end;
  7159. end;
  7160. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7161. function TglBitmap2D.FlipVert: Boolean;
  7162. var
  7163. Row: Integer;
  7164. TempDestData, DestData, SourceData: PByte;
  7165. begin
  7166. result := inherited FlipVert;
  7167. if Assigned(Data) then begin
  7168. SourceData := Data;
  7169. GetMem(DestData, Height * fRowSize);
  7170. try
  7171. TempDestData := DestData;
  7172. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7173. for Row := 0 to Height -1 do begin
  7174. Move(SourceData^, TempDestData^, fRowSize);
  7175. Dec(TempDestData, fRowSize);
  7176. Inc(SourceData, fRowSize);
  7177. end;
  7178. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7179. result := true;
  7180. except
  7181. if Assigned(DestData) then
  7182. FreeMem(DestData);
  7183. raise;
  7184. end;
  7185. end;
  7186. end;
  7187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7188. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7189. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7190. type
  7191. TMatrixItem = record
  7192. X, Y: Integer;
  7193. W: Single;
  7194. end;
  7195. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7196. TglBitmapToNormalMapRec = Record
  7197. Scale: Single;
  7198. Heights: array of Single;
  7199. MatrixU : array of TMatrixItem;
  7200. MatrixV : array of TMatrixItem;
  7201. end;
  7202. const
  7203. ONE_OVER_255 = 1 / 255;
  7204. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7205. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7206. var
  7207. Val: Single;
  7208. begin
  7209. with FuncRec do begin
  7210. Val :=
  7211. Source.Data.r * LUMINANCE_WEIGHT_R +
  7212. Source.Data.g * LUMINANCE_WEIGHT_G +
  7213. Source.Data.b * LUMINANCE_WEIGHT_B;
  7214. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7215. end;
  7216. end;
  7217. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7218. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7219. begin
  7220. with FuncRec do
  7221. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7222. end;
  7223. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7224. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7225. type
  7226. TVec = Array[0..2] of Single;
  7227. var
  7228. Idx: Integer;
  7229. du, dv: Double;
  7230. Len: Single;
  7231. Vec: TVec;
  7232. function GetHeight(X, Y: Integer): Single;
  7233. begin
  7234. with FuncRec do begin
  7235. X := Max(0, Min(Size.X -1, X));
  7236. Y := Max(0, Min(Size.Y -1, Y));
  7237. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7238. end;
  7239. end;
  7240. begin
  7241. with FuncRec do begin
  7242. with PglBitmapToNormalMapRec(Args)^ do begin
  7243. du := 0;
  7244. for Idx := Low(MatrixU) to High(MatrixU) do
  7245. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7246. dv := 0;
  7247. for Idx := Low(MatrixU) to High(MatrixU) do
  7248. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7249. Vec[0] := -du * Scale;
  7250. Vec[1] := -dv * Scale;
  7251. Vec[2] := 1;
  7252. end;
  7253. // Normalize
  7254. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7255. if Len <> 0 then begin
  7256. Vec[0] := Vec[0] * Len;
  7257. Vec[1] := Vec[1] * Len;
  7258. Vec[2] := Vec[2] * Len;
  7259. end;
  7260. // Farbe zuweisem
  7261. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7262. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7263. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7264. end;
  7265. end;
  7266. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7267. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7268. var
  7269. Rec: TglBitmapToNormalMapRec;
  7270. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7271. begin
  7272. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7273. Matrix[Index].X := X;
  7274. Matrix[Index].Y := Y;
  7275. Matrix[Index].W := W;
  7276. end;
  7277. end;
  7278. begin
  7279. if TFormatDescriptor.Get(Format).IsCompressed then
  7280. raise EglBitmapUnsupportedFormat.Create(Format);
  7281. if aScale > 100 then
  7282. Rec.Scale := 100
  7283. else if aScale < -100 then
  7284. Rec.Scale := -100
  7285. else
  7286. Rec.Scale := aScale;
  7287. SetLength(Rec.Heights, Width * Height);
  7288. try
  7289. case aFunc of
  7290. nm4Samples: begin
  7291. SetLength(Rec.MatrixU, 2);
  7292. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7293. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7294. SetLength(Rec.MatrixV, 2);
  7295. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7296. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7297. end;
  7298. nmSobel: begin
  7299. SetLength(Rec.MatrixU, 6);
  7300. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7301. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7302. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7303. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7304. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7305. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7306. SetLength(Rec.MatrixV, 6);
  7307. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7308. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7309. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7310. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7311. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7312. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7313. end;
  7314. nm3x3: begin
  7315. SetLength(Rec.MatrixU, 6);
  7316. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7317. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7318. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7319. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7320. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7321. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7322. SetLength(Rec.MatrixV, 6);
  7323. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7324. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7325. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7326. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7327. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7328. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7329. end;
  7330. nm5x5: begin
  7331. SetLength(Rec.MatrixU, 20);
  7332. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7333. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7334. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7335. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7336. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7337. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7338. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7339. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7340. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7341. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7342. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7343. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7344. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7345. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7346. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7347. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7348. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7349. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7350. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7351. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7352. SetLength(Rec.MatrixV, 20);
  7353. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7354. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7355. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7356. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7357. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7358. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7359. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7360. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7361. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7362. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7363. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7364. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7365. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7366. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7367. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7368. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7369. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7370. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7371. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7372. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7373. end;
  7374. end;
  7375. // Daten Sammeln
  7376. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7377. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7378. else
  7379. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7380. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7381. finally
  7382. SetLength(Rec.Heights, 0);
  7383. end;
  7384. end;
  7385. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7386. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7387. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7388. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7389. begin
  7390. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7391. end;
  7392. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7393. procedure TglBitmapCubeMap.AfterConstruction;
  7394. begin
  7395. inherited;
  7396. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7397. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7398. SetWrap;
  7399. Target := GL_TEXTURE_CUBE_MAP;
  7400. fGenMode := GL_REFLECTION_MAP;
  7401. end;
  7402. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7403. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7404. var
  7405. BuildWithGlu: Boolean;
  7406. TexSize: Integer;
  7407. begin
  7408. if (aTestTextureSize) then begin
  7409. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7410. if (Height > TexSize) or (Width > TexSize) then
  7411. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7412. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7413. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7414. end;
  7415. if (ID = 0) then
  7416. CreateID;
  7417. SetupParameters(BuildWithGlu);
  7418. UploadData(aCubeTarget, BuildWithGlu);
  7419. end;
  7420. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7421. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
  7422. begin
  7423. inherited Bind (aEnableTextureUnit);
  7424. if aEnableTexCoordsGen then begin
  7425. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7426. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7427. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7428. glEnable(GL_TEXTURE_GEN_S);
  7429. glEnable(GL_TEXTURE_GEN_T);
  7430. glEnable(GL_TEXTURE_GEN_R);
  7431. end;
  7432. end;
  7433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7434. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
  7435. begin
  7436. inherited Unbind(aDisableTextureUnit);
  7437. if aDisableTexCoordsGen then begin
  7438. glDisable(GL_TEXTURE_GEN_S);
  7439. glDisable(GL_TEXTURE_GEN_T);
  7440. glDisable(GL_TEXTURE_GEN_R);
  7441. end;
  7442. end;
  7443. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7444. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7446. type
  7447. TVec = Array[0..2] of Single;
  7448. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7449. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7450. TglBitmapNormalMapRec = record
  7451. HalfSize : Integer;
  7452. Func: TglBitmapNormalMapGetVectorFunc;
  7453. end;
  7454. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7455. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7456. begin
  7457. aVec[0] := aHalfSize;
  7458. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7459. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7460. end;
  7461. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7462. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7463. begin
  7464. aVec[0] := - aHalfSize;
  7465. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7466. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7467. end;
  7468. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7469. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7470. begin
  7471. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7472. aVec[1] := aHalfSize;
  7473. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7474. end;
  7475. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7476. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7477. begin
  7478. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7479. aVec[1] := - aHalfSize;
  7480. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7481. end;
  7482. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7483. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7484. begin
  7485. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7486. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7487. aVec[2] := aHalfSize;
  7488. end;
  7489. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7490. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7491. begin
  7492. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7493. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7494. aVec[2] := - aHalfSize;
  7495. end;
  7496. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7497. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7498. var
  7499. i: Integer;
  7500. Vec: TVec;
  7501. Len: Single;
  7502. begin
  7503. with FuncRec do begin
  7504. with PglBitmapNormalMapRec(Args)^ do begin
  7505. Func(Vec, Position, HalfSize);
  7506. // Normalize
  7507. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7508. if Len <> 0 then begin
  7509. Vec[0] := Vec[0] * Len;
  7510. Vec[1] := Vec[1] * Len;
  7511. Vec[2] := Vec[2] * Len;
  7512. end;
  7513. // Scale Vector and AddVectro
  7514. Vec[0] := Vec[0] * 0.5 + 0.5;
  7515. Vec[1] := Vec[1] * 0.5 + 0.5;
  7516. Vec[2] := Vec[2] * 0.5 + 0.5;
  7517. end;
  7518. // Set Color
  7519. for i := 0 to 2 do
  7520. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7521. end;
  7522. end;
  7523. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7524. procedure TglBitmapNormalMap.AfterConstruction;
  7525. begin
  7526. inherited;
  7527. fGenMode := GL_NORMAL_MAP;
  7528. end;
  7529. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7530. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7531. var
  7532. Rec: TglBitmapNormalMapRec;
  7533. SizeRec: TglBitmapPixelPosition;
  7534. begin
  7535. Rec.HalfSize := aSize div 2;
  7536. FreeDataAfterGenTexture := false;
  7537. SizeRec.Fields := [ffX, ffY];
  7538. SizeRec.X := aSize;
  7539. SizeRec.Y := aSize;
  7540. // Positive X
  7541. Rec.Func := glBitmapNormalMapPosX;
  7542. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7543. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7544. // Negative X
  7545. Rec.Func := glBitmapNormalMapNegX;
  7546. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7547. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7548. // Positive Y
  7549. Rec.Func := glBitmapNormalMapPosY;
  7550. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7551. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7552. // Negative Y
  7553. Rec.Func := glBitmapNormalMapNegY;
  7554. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7555. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7556. // Positive Z
  7557. Rec.Func := glBitmapNormalMapPosZ;
  7558. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7559. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7560. // Negative Z
  7561. Rec.Func := glBitmapNormalMapNegZ;
  7562. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7563. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7564. end;
  7565. initialization
  7566. glBitmapSetDefaultFormat (tfEmpty);
  7567. glBitmapSetDefaultMipmap (mmMipmap);
  7568. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7569. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7570. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7571. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7572. glBitmapSetDefaultDeleteTextureOnFree (true);
  7573. TFormatDescriptor.Init;
  7574. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7575. OpenGLInitialized := false;
  7576. InitOpenGLCS := TCriticalSection.Create;
  7577. {$ENDIF}
  7578. finalization
  7579. TFormatDescriptor.Finalize;
  7580. {$IFDEF GLB_NATIVE_OGL}
  7581. if Assigned(GL_LibHandle) then
  7582. glbFreeLibrary(GL_LibHandle);
  7583. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7584. if Assigned(GLU_LibHandle) then
  7585. glbFreeLibrary(GLU_LibHandle);
  7586. FreeAndNil(InitOpenGLCS);
  7587. {$ENDIF}
  7588. {$ENDIF}
  7589. end.