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.

8637 lines
297 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.0 unstable
  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 warn '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 TBitmap from Delphi (not lazarus)
  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 GetHasAlpha: Boolean; virtual; abstract;
  761. function GetglDataFormat: GLenum; virtual; abstract;
  762. function GetglFormat: GLenum; virtual; abstract;
  763. function GetglInternalFormat: GLenum; virtual; abstract;
  764. public
  765. property IsCompressed: Boolean read GetIsCompressed;
  766. property HasAlpha: Boolean read GetHasAlpha;
  767. property glFormat: GLenum read GetglFormat;
  768. property glInternalFormat: GLenum read GetglInternalFormat;
  769. property glDataFormat: GLenum read GetglDataFormat;
  770. end;
  771. ////////////////////////////////////////////////////////////////////////////////////////////////////
  772. TglBitmap = class;
  773. TglBitmapFunctionRec = record
  774. Sender: TglBitmap;
  775. Size: TglBitmapPixelPosition;
  776. Position: TglBitmapPixelPosition;
  777. Source: TglBitmapPixelData;
  778. Dest: TglBitmapPixelData;
  779. Args: Pointer;
  780. end;
  781. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  782. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  783. TglBitmap = class
  784. private
  785. function GetFormatDesc: TglBitmapFormatDescriptor;
  786. protected
  787. fID: GLuint;
  788. fTarget: GLuint;
  789. fAnisotropic: Integer;
  790. fDeleteTextureOnFree: Boolean;
  791. fFreeDataOnDestroy: Boolean;
  792. fFreeDataAfterGenTexture: Boolean;
  793. fData: PByte;
  794. fIsResident: Boolean;
  795. fBorderColor: array[0..3] of Single;
  796. fDimension: TglBitmapPixelPosition;
  797. fMipMap: TglBitmapMipMap;
  798. fFormat: TglBitmapFormat;
  799. // Mapping
  800. fPixelSize: Integer;
  801. fRowSize: Integer;
  802. // Filtering
  803. fFilterMin: GLenum;
  804. fFilterMag: GLenum;
  805. // TexturWarp
  806. fWrapS: GLenum;
  807. fWrapT: GLenum;
  808. fWrapR: GLenum;
  809. //Swizzle
  810. fSwizzle: array[0..3] of GLenum;
  811. // CustomData
  812. fFilename: String;
  813. fCustomName: String;
  814. fCustomNameW: WideString;
  815. fCustomData: Pointer;
  816. //Getter
  817. function GetWidth: Integer; virtual;
  818. function GetHeight: Integer; virtual;
  819. function GetFileWidth: Integer; virtual;
  820. function GetFileHeight: Integer; virtual;
  821. //Setter
  822. procedure SetCustomData(const aValue: Pointer);
  823. procedure SetCustomName(const aValue: String);
  824. procedure SetCustomNameW(const aValue: WideString);
  825. procedure SetFreeDataOnDestroy(const aValue: Boolean);
  826. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  827. procedure SetFormat(const aValue: TglBitmapFormat);
  828. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  829. procedure SetID(const aValue: Cardinal);
  830. procedure SetMipMap(const aValue: TglBitmapMipMap);
  831. procedure SetTarget(const aValue: Cardinal);
  832. procedure SetAnisotropic(const aValue: Integer);
  833. procedure CreateID;
  834. procedure SetupParameters(out aBuildWithGlu: Boolean);
  835. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  836. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method
  837. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  838. function FlipHorz: Boolean; virtual;
  839. function FlipVert: Boolean; virtual;
  840. property Width: Integer read GetWidth;
  841. property Height: Integer read GetHeight;
  842. property FileWidth: Integer read GetFileWidth;
  843. property FileHeight: Integer read GetFileHeight;
  844. public
  845. //Properties
  846. property ID: Cardinal read fID write SetID;
  847. property Target: Cardinal read fTarget write SetTarget;
  848. property Format: TglBitmapFormat read fFormat write SetFormat;
  849. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  850. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  851. property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc;
  852. property Filename: String read fFilename;
  853. property CustomName: String read fCustomName write SetCustomName;
  854. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  855. property CustomData: Pointer read fCustomData write SetCustomData;
  856. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  857. property FreeDataOnDestroy: Boolean read fFreeDataOnDestroy write SetFreeDataOnDestroy;
  858. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  859. property Dimension: TglBitmapPixelPosition read fDimension;
  860. property Data: PByte read fData;
  861. property IsResident: Boolean read fIsResident;
  862. procedure AfterConstruction; override;
  863. procedure BeforeDestruction; override;
  864. procedure PrepareResType(var aResource: String; var aResType: PChar);
  865. //Load
  866. procedure LoadFromFile(const aFilename: String);
  867. procedure LoadFromStream(const aStream: TStream); virtual;
  868. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  869. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  870. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  871. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  872. //Save
  873. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  874. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  875. //Convert
  876. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  877. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  878. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  879. public
  880. //Alpha & Co
  881. {$IFDEF GLB_SDL}
  882. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  883. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  884. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  885. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  886. const aArgs: Pointer = nil): Boolean;
  887. {$ENDIF}
  888. {$IFDEF GLB_DELPHI}
  889. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  890. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  891. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  892. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  893. const aArgs: Pointer = nil): Boolean;
  894. {$ENDIF}
  895. {$IFDEF GLB_LAZARUS}
  896. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  897. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  898. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  899. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  900. const aArgs: Pointer = nil): Boolean;
  901. {$ENDIF}
  902. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  903. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  904. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  905. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  906. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  907. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  908. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  909. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  910. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  911. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  912. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  913. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  914. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  915. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  916. function RemoveAlpha: Boolean; virtual;
  917. public
  918. //Common
  919. function Clone: TglBitmap;
  920. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  921. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  922. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  923. procedure FreeData;
  924. //ColorFill
  925. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  926. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  927. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  928. //TexParameters
  929. procedure SetFilter(const aMin, aMag: GLenum);
  930. procedure SetWrap(
  931. const S: GLenum = GL_CLAMP_TO_EDGE;
  932. const T: GLenum = GL_CLAMP_TO_EDGE;
  933. const R: GLenum = GL_CLAMP_TO_EDGE);
  934. procedure SetSwizzle(const r, g, b, a: GLenum);
  935. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  936. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  937. //Constructors
  938. constructor Create; overload;
  939. constructor Create(const aFileName: String); overload;
  940. constructor Create(const aStream: TStream); overload;
  941. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  942. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  943. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  944. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  945. private
  946. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  947. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  948. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  949. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  950. function LoadBMP(const aStream: TStream): Boolean; virtual;
  951. procedure SaveBMP(const aStream: TStream); virtual;
  952. function LoadTGA(const aStream: TStream): Boolean; virtual;
  953. procedure SaveTGA(const aStream: TStream); virtual;
  954. function LoadDDS(const aStream: TStream): Boolean; virtual;
  955. procedure SaveDDS(const aStream: TStream); virtual;
  956. end;
  957. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  958. TglBitmap1D = class(TglBitmap)
  959. protected
  960. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  961. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  962. procedure UploadData(const aBuildWithGlu: Boolean);
  963. public
  964. property Width;
  965. procedure AfterConstruction; override;
  966. function FlipHorz: Boolean; override;
  967. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  968. end;
  969. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  970. TglBitmap2D = class(TglBitmap)
  971. protected
  972. fLines: array of PByte;
  973. function GetScanline(const aIndex: Integer): Pointer;
  974. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  975. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  976. procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  977. public
  978. property Width;
  979. property Height;
  980. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  981. procedure AfterConstruction; override;
  982. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  983. procedure GetDataFromTexture;
  984. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  985. function FlipHorz: Boolean; override;
  986. function FlipVert: Boolean; override;
  987. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  988. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  989. end;
  990. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  991. TglBitmapCubeMap = class(TglBitmap2D)
  992. protected
  993. fGenMode: Integer;
  994. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  995. public
  996. procedure AfterConstruction; override;
  997. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  998. procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  999. procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  1000. end;
  1001. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1002. TglBitmapNormalMap = class(TglBitmapCubeMap)
  1003. public
  1004. procedure AfterConstruction; override;
  1005. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  1006. end;
  1007. const
  1008. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1009. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1010. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1011. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1012. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1013. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1014. procedure glBitmapSetDefaultWrap(
  1015. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1016. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1017. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1018. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1019. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1020. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1021. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1022. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1023. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1024. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1025. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1026. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1027. var
  1028. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1029. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1030. glBitmapDefaultFormat: TglBitmapFormat;
  1031. glBitmapDefaultMipmap: TglBitmapMipMap;
  1032. glBitmapDefaultFilterMin: Cardinal;
  1033. glBitmapDefaultFilterMag: Cardinal;
  1034. glBitmapDefaultWrapS: Cardinal;
  1035. glBitmapDefaultWrapT: Cardinal;
  1036. glBitmapDefaultWrapR: Cardinal;
  1037. glDefaultSwizzle: array[0..3] of GLenum;
  1038. {$IFDEF GLB_DELPHI}
  1039. function CreateGrayPalette: HPALETTE;
  1040. {$ENDIF}
  1041. implementation
  1042. uses
  1043. Math, syncobjs, typinfo
  1044. {$IFDEF GLB_DELPHI}, Types{$ENDIF};
  1045. type
  1046. {$IFNDEF fpc}
  1047. QWord = System.UInt64;
  1048. PQWord = ^QWord;
  1049. PtrInt = Longint;
  1050. PtrUInt = DWord;
  1051. {$ENDIF}
  1052. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1053. TShiftRec = packed record
  1054. case Integer of
  1055. 0: (r, g, b, a: Byte);
  1056. 1: (arr: array[0..3] of Byte);
  1057. end;
  1058. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1059. private
  1060. function GetRedMask: QWord;
  1061. function GetGreenMask: QWord;
  1062. function GetBlueMask: QWord;
  1063. function GetAlphaMask: QWord;
  1064. protected
  1065. fFormat: TglBitmapFormat;
  1066. fWithAlpha: TglBitmapFormat;
  1067. fWithoutAlpha: TglBitmapFormat;
  1068. fRGBInverted: TglBitmapFormat;
  1069. fUncompressed: TglBitmapFormat;
  1070. fPixelSize: Single;
  1071. fIsCompressed: Boolean;
  1072. fRange: TglBitmapColorRec;
  1073. fShift: TShiftRec;
  1074. fglFormat: GLenum;
  1075. fglInternalFormat: GLenum;
  1076. fglDataFormat: GLenum;
  1077. function GetIsCompressed: Boolean; override;
  1078. function GetHasAlpha: Boolean; override;
  1079. function GetglFormat: GLenum; override;
  1080. function GetglInternalFormat: GLenum; override;
  1081. function GetglDataFormat: GLenum; override;
  1082. function GetComponents: Integer; virtual;
  1083. public
  1084. property Format: TglBitmapFormat read fFormat;
  1085. property WithAlpha: TglBitmapFormat read fWithAlpha;
  1086. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  1087. property RGBInverted: TglBitmapFormat read fRGBInverted;
  1088. property Components: Integer read GetComponents;
  1089. property PixelSize: Single read fPixelSize;
  1090. property Range: TglBitmapColorRec read fRange;
  1091. property Shift: TShiftRec read fShift;
  1092. property RedMask: QWord read GetRedMask;
  1093. property GreenMask: QWord read GetGreenMask;
  1094. property BlueMask: QWord read GetBlueMask;
  1095. property AlphaMask: QWord read GetAlphaMask;
  1096. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1097. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1098. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1099. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1100. function CreateMappingData: Pointer; virtual;
  1101. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1102. function IsEmpty: Boolean; virtual;
  1103. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  1104. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1105. constructor Create; virtual;
  1106. public
  1107. class procedure Init;
  1108. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1109. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1110. class procedure Clear;
  1111. class procedure Finalize;
  1112. end;
  1113. TFormatDescriptorClass = class of TFormatDescriptor;
  1114. TfdEmpty = class(TFormatDescriptor);
  1115. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1116. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1117. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1118. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1119. constructor Create; override;
  1120. end;
  1121. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1122. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1123. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1124. constructor Create; override;
  1125. end;
  1126. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1127. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1128. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1129. constructor Create; override;
  1130. end;
  1131. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1132. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1133. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1134. constructor Create; override;
  1135. end;
  1136. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1137. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1138. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1139. constructor Create; override;
  1140. end;
  1141. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1142. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1143. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1144. constructor Create; override;
  1145. end;
  1146. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1147. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1148. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1149. constructor Create; override;
  1150. end;
  1151. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1152. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1153. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1154. constructor Create; override;
  1155. end;
  1156. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1157. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  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. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  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. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  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. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1173. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1174. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1175. constructor Create; override;
  1176. end;
  1177. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1178. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1179. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1180. constructor Create; override;
  1181. end;
  1182. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1183. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1184. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1185. constructor Create; override;
  1186. end;
  1187. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1188. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1189. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1190. constructor Create; override;
  1191. end;
  1192. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1193. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1194. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1195. constructor Create; override;
  1196. end;
  1197. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1198. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1199. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1200. constructor Create; override;
  1201. end;
  1202. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1203. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  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. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  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. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1214. TfdAlpha4 = class(TfdAlpha_UB1)
  1215. constructor Create; override;
  1216. end;
  1217. TfdAlpha8 = class(TfdAlpha_UB1)
  1218. constructor Create; override;
  1219. end;
  1220. TfdAlpha12 = class(TfdAlpha_US1)
  1221. constructor Create; override;
  1222. end;
  1223. TfdAlpha16 = class(TfdAlpha_US1)
  1224. constructor Create; override;
  1225. end;
  1226. TfdLuminance4 = class(TfdLuminance_UB1)
  1227. constructor Create; override;
  1228. end;
  1229. TfdLuminance8 = class(TfdLuminance_UB1)
  1230. constructor Create; override;
  1231. end;
  1232. TfdLuminance12 = class(TfdLuminance_US1)
  1233. constructor Create; override;
  1234. end;
  1235. TfdLuminance16 = class(TfdLuminance_US1)
  1236. constructor Create; override;
  1237. end;
  1238. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1239. constructor Create; override;
  1240. end;
  1241. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1242. constructor Create; override;
  1243. end;
  1244. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1245. constructor Create; override;
  1246. end;
  1247. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1248. constructor Create; override;
  1249. end;
  1250. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1251. constructor Create; override;
  1252. end;
  1253. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1254. constructor Create; override;
  1255. end;
  1256. TfdR3G3B2 = class(TfdUniversal_UB1)
  1257. constructor Create; override;
  1258. end;
  1259. TfdRGB4 = class(TfdUniversal_US1)
  1260. constructor Create; override;
  1261. end;
  1262. TfdR5G6B5 = class(TfdUniversal_US1)
  1263. constructor Create; override;
  1264. end;
  1265. TfdRGB5 = class(TfdUniversal_US1)
  1266. constructor Create; override;
  1267. end;
  1268. TfdRGB8 = class(TfdRGB_UB3)
  1269. constructor Create; override;
  1270. end;
  1271. TfdRGB10 = class(TfdUniversal_UI1)
  1272. constructor Create; override;
  1273. end;
  1274. TfdRGB12 = class(TfdRGB_US3)
  1275. constructor Create; override;
  1276. end;
  1277. TfdRGB16 = class(TfdRGB_US3)
  1278. constructor Create; override;
  1279. end;
  1280. TfdRGBA2 = class(TfdRGBA_UB4)
  1281. constructor Create; override;
  1282. end;
  1283. TfdRGBA4 = class(TfdUniversal_US1)
  1284. constructor Create; override;
  1285. end;
  1286. TfdRGB5A1 = class(TfdUniversal_US1)
  1287. constructor Create; override;
  1288. end;
  1289. TfdRGBA8 = class(TfdRGBA_UB4)
  1290. constructor Create; override;
  1291. end;
  1292. TfdRGB10A2 = class(TfdUniversal_UI1)
  1293. constructor Create; override;
  1294. end;
  1295. TfdRGBA12 = class(TfdRGBA_US4)
  1296. constructor Create; override;
  1297. end;
  1298. TfdRGBA16 = class(TfdRGBA_US4)
  1299. constructor Create; override;
  1300. end;
  1301. TfdBGR4 = class(TfdUniversal_US1)
  1302. constructor Create; override;
  1303. end;
  1304. TfdB5G6R5 = class(TfdUniversal_US1)
  1305. constructor Create; override;
  1306. end;
  1307. TfdBGR5 = class(TfdUniversal_US1)
  1308. constructor Create; override;
  1309. end;
  1310. TfdBGR8 = class(TfdBGR_UB3)
  1311. constructor Create; override;
  1312. end;
  1313. TfdBGR10 = class(TfdUniversal_UI1)
  1314. constructor Create; override;
  1315. end;
  1316. TfdBGR12 = class(TfdBGR_US3)
  1317. constructor Create; override;
  1318. end;
  1319. TfdBGR16 = class(TfdBGR_US3)
  1320. constructor Create; override;
  1321. end;
  1322. TfdBGRA2 = class(TfdBGRA_UB4)
  1323. constructor Create; override;
  1324. end;
  1325. TfdBGRA4 = class(TfdUniversal_US1)
  1326. constructor Create; override;
  1327. end;
  1328. TfdBGR5A1 = class(TfdUniversal_US1)
  1329. constructor Create; override;
  1330. end;
  1331. TfdBGRA8 = class(TfdBGRA_UB4)
  1332. constructor Create; override;
  1333. end;
  1334. TfdBGR10A2 = class(TfdUniversal_UI1)
  1335. constructor Create; override;
  1336. end;
  1337. TfdBGRA12 = class(TfdBGRA_US4)
  1338. constructor Create; override;
  1339. end;
  1340. TfdBGRA16 = class(TfdBGRA_US4)
  1341. constructor Create; override;
  1342. end;
  1343. TfdDepth16 = class(TfdDepth_US1)
  1344. constructor Create; override;
  1345. end;
  1346. TfdDepth24 = class(TfdDepth_UI1)
  1347. constructor Create; override;
  1348. end;
  1349. TfdDepth32 = class(TfdDepth_UI1)
  1350. constructor Create; override;
  1351. end;
  1352. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1353. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1354. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1355. constructor Create; override;
  1356. end;
  1357. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1358. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1359. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1360. constructor Create; override;
  1361. end;
  1362. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1363. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1364. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1365. constructor Create; override;
  1366. end;
  1367. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1368. TbmpBitfieldFormat = class(TFormatDescriptor)
  1369. private
  1370. procedure SetRedMask (const aValue: QWord);
  1371. procedure SetGreenMask(const aValue: QWord);
  1372. procedure SetBlueMask (const aValue: QWord);
  1373. procedure SetAlphaMask(const aValue: QWord);
  1374. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1375. public
  1376. property RedMask: QWord read GetRedMask write SetRedMask;
  1377. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1378. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1379. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1380. property PixelSize: Single read fPixelSize write fPixelSize;
  1381. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1382. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1383. end;
  1384. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1385. TbmpColorTableEnty = packed record
  1386. b, g, r, a: Byte;
  1387. end;
  1388. TbmpColorTable = array of TbmpColorTableEnty;
  1389. TbmpColorTableFormat = class(TFormatDescriptor)
  1390. private
  1391. fColorTable: TbmpColorTable;
  1392. public
  1393. property PixelSize: Single read fPixelSize write fPixelSize;
  1394. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1395. property Range: TglBitmapColorRec read fRange write fRange;
  1396. property Shift: TShiftRec read fShift write fShift;
  1397. property Format: TglBitmapFormat read fFormat write fFormat;
  1398. procedure CreateColorTable;
  1399. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1400. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1401. destructor Destroy; override;
  1402. end;
  1403. const
  1404. LUMINANCE_WEIGHT_R = 0.30;
  1405. LUMINANCE_WEIGHT_G = 0.59;
  1406. LUMINANCE_WEIGHT_B = 0.11;
  1407. ALPHA_WEIGHT_R = 0.30;
  1408. ALPHA_WEIGHT_G = 0.59;
  1409. ALPHA_WEIGHT_B = 0.11;
  1410. DEPTH_WEIGHT_R = 0.333333333;
  1411. DEPTH_WEIGHT_G = 0.333333333;
  1412. DEPTH_WEIGHT_B = 0.333333333;
  1413. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1414. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1415. TfdEmpty,
  1416. TfdAlpha4,
  1417. TfdAlpha8,
  1418. TfdAlpha12,
  1419. TfdAlpha16,
  1420. TfdLuminance4,
  1421. TfdLuminance8,
  1422. TfdLuminance12,
  1423. TfdLuminance16,
  1424. TfdLuminance4Alpha4,
  1425. TfdLuminance6Alpha2,
  1426. TfdLuminance8Alpha8,
  1427. TfdLuminance12Alpha4,
  1428. TfdLuminance12Alpha12,
  1429. TfdLuminance16Alpha16,
  1430. TfdR3G3B2,
  1431. TfdRGB4,
  1432. TfdR5G6B5,
  1433. TfdRGB5,
  1434. TfdRGB8,
  1435. TfdRGB10,
  1436. TfdRGB12,
  1437. TfdRGB16,
  1438. TfdRGBA2,
  1439. TfdRGBA4,
  1440. TfdRGB5A1,
  1441. TfdRGBA8,
  1442. TfdRGB10A2,
  1443. TfdRGBA12,
  1444. TfdRGBA16,
  1445. TfdBGR4,
  1446. TfdB5G6R5,
  1447. TfdBGR5,
  1448. TfdBGR8,
  1449. TfdBGR10,
  1450. TfdBGR12,
  1451. TfdBGR16,
  1452. TfdBGRA2,
  1453. TfdBGRA4,
  1454. TfdBGR5A1,
  1455. TfdBGRA8,
  1456. TfdBGR10A2,
  1457. TfdBGRA12,
  1458. TfdBGRA16,
  1459. TfdDepth16,
  1460. TfdDepth24,
  1461. TfdDepth32,
  1462. TfdS3tcDtx1RGBA,
  1463. TfdS3tcDtx3RGBA,
  1464. TfdS3tcDtx5RGBA
  1465. );
  1466. var
  1467. FormatDescriptorCS: TCriticalSection;
  1468. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1469. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1470. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1471. begin
  1472. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1473. end;
  1474. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1475. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1476. begin
  1477. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1478. end;
  1479. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1480. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1481. begin
  1482. result.Fields := [];
  1483. if X >= 0 then
  1484. result.Fields := result.Fields + [ffX];
  1485. if Y >= 0 then
  1486. result.Fields := result.Fields + [ffY];
  1487. result.X := Max(0, X);
  1488. result.Y := Max(0, Y);
  1489. end;
  1490. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1491. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1492. begin
  1493. result.r := r;
  1494. result.g := g;
  1495. result.b := b;
  1496. result.a := a;
  1497. end;
  1498. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1499. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1500. var
  1501. i: Integer;
  1502. begin
  1503. result := false;
  1504. for i := 0 to high(r1.arr) do
  1505. if (r1.arr[i] <> r2.arr[i]) then
  1506. exit;
  1507. result := true;
  1508. end;
  1509. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1510. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1511. begin
  1512. result.r := r;
  1513. result.g := g;
  1514. result.b := b;
  1515. result.a := a;
  1516. end;
  1517. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1518. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1519. begin
  1520. result := [];
  1521. if (aFormat in [
  1522. //4 bbp
  1523. tfLuminance4,
  1524. //8bpp
  1525. tfR3G3B2, tfLuminance8,
  1526. //16bpp
  1527. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1528. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1529. //24bpp
  1530. tfBGR8, tfRGB8,
  1531. //32bpp
  1532. tfRGB10, tfRGB10A2, tfRGBA8,
  1533. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1534. result := result + [ftBMP];
  1535. if (aFormat in [
  1536. //8 bpp
  1537. tfLuminance8, tfAlpha8,
  1538. //16 bpp
  1539. tfLuminance16, tfLuminance8Alpha8,
  1540. tfRGB5, tfRGB5A1, tfRGBA4,
  1541. tfBGR5, tfBGR5A1, tfBGRA4,
  1542. //24 bpp
  1543. tfRGB8, tfBGR8,
  1544. //32 bpp
  1545. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1546. result := result + [ftTGA];
  1547. if (aFormat in [
  1548. //8 bpp
  1549. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1550. tfR3G3B2, tfRGBA2, tfBGRA2,
  1551. //16 bpp
  1552. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1553. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1554. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1555. //24 bpp
  1556. tfRGB8, tfBGR8,
  1557. //32 bbp
  1558. tfLuminance16Alpha16,
  1559. tfRGBA8, tfRGB10A2,
  1560. tfBGRA8, tfBGR10A2,
  1561. //compressed
  1562. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1563. result := result + [ftDDS];
  1564. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1565. if aFormat in [
  1566. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1567. tfRGB8, tfRGBA8,
  1568. tfBGR8, tfBGRA8] then
  1569. result := result + [ftPNG];
  1570. {$ENDIF}
  1571. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1572. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1573. result := result + [ftJPEG];
  1574. {$ENDIF}
  1575. end;
  1576. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1577. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1578. begin
  1579. while (aNumber and 1) = 0 do
  1580. aNumber := aNumber shr 1;
  1581. result := aNumber = 1;
  1582. end;
  1583. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1584. function GetTopMostBit(aBitSet: QWord): Integer;
  1585. begin
  1586. result := 0;
  1587. while aBitSet > 0 do begin
  1588. inc(result);
  1589. aBitSet := aBitSet shr 1;
  1590. end;
  1591. end;
  1592. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1593. function CountSetBits(aBitSet: QWord): Integer;
  1594. begin
  1595. result := 0;
  1596. while aBitSet > 0 do begin
  1597. if (aBitSet and 1) = 1 then
  1598. inc(result);
  1599. aBitSet := aBitSet shr 1;
  1600. end;
  1601. end;
  1602. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1603. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1604. begin
  1605. result := Trunc(
  1606. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1607. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1608. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1609. end;
  1610. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1611. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1612. begin
  1613. result := Trunc(
  1614. DEPTH_WEIGHT_R * aPixel.Data.r +
  1615. DEPTH_WEIGHT_G * aPixel.Data.g +
  1616. DEPTH_WEIGHT_B * aPixel.Data.b);
  1617. end;
  1618. {$IFDEF GLB_NATIVE_OGL}
  1619. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1620. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1621. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1622. var
  1623. GL_LibHandle: Pointer = nil;
  1624. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
  1625. begin
  1626. if not Assigned(aLibHandle) then
  1627. aLibHandle := GL_LibHandle;
  1628. {$IF DEFINED(GLB_WIN)}
  1629. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1630. if Assigned(result) then
  1631. exit;
  1632. if Assigned(wglGetProcAddress) then
  1633. result := wglGetProcAddress(aProcName);
  1634. {$ELSEIF DEFINED(GLB_LINUX)}
  1635. if Assigned(glXGetProcAddress) then begin
  1636. result := glXGetProcAddress(aProcName);
  1637. if Assigned(result) then
  1638. exit;
  1639. end;
  1640. if Assigned(glXGetProcAddressARB) then begin
  1641. result := glXGetProcAddressARB(aProcName);
  1642. if Assigned(result) then
  1643. exit;
  1644. end;
  1645. result := dlsym(aLibHandle, aProcName);
  1646. {$IFEND}
  1647. if not Assigned(result) and aRaiseOnErr then
  1648. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1649. end;
  1650. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1651. var
  1652. GLU_LibHandle: Pointer = nil;
  1653. OpenGLInitialized: Boolean;
  1654. InitOpenGLCS: TCriticalSection;
  1655. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1656. procedure glbInitOpenGL;
  1657. ////////////////////////////////////////////////////////////////////////////////
  1658. function glbLoadLibrary(const aName: PChar): Pointer;
  1659. begin
  1660. {$IF DEFINED(GLB_WIN)}
  1661. result := {%H-}Pointer(LoadLibrary(aName));
  1662. {$ELSEIF DEFINED(GLB_LINUX)}
  1663. result := dlopen(Name, RTLD_LAZY);
  1664. {$ELSE}
  1665. result := nil;
  1666. {$IFEND}
  1667. end;
  1668. ////////////////////////////////////////////////////////////////////////////////
  1669. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1670. begin
  1671. result := false;
  1672. if not Assigned(aLibHandle) then
  1673. exit;
  1674. {$IF DEFINED(GLB_WIN)}
  1675. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1676. {$ELSEIF DEFINED(GLB_LINUX)}
  1677. Result := dlclose(aLibHandle) = 0;
  1678. {$IFEND}
  1679. end;
  1680. begin
  1681. if Assigned(GL_LibHandle) then
  1682. glbFreeLibrary(GL_LibHandle);
  1683. if Assigned(GLU_LibHandle) then
  1684. glbFreeLibrary(GLU_LibHandle);
  1685. GL_LibHandle := glbLoadLibrary(libopengl);
  1686. if not Assigned(GL_LibHandle) then
  1687. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1688. GLU_LibHandle := glbLoadLibrary(libglu);
  1689. if not Assigned(GLU_LibHandle) then
  1690. raise EglBitmap.Create('unable to load library: ' + libglu);
  1691. {$IF DEFINED(GLB_WIN)}
  1692. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1693. {$ELSEIF DEFINED(GLB_LINUX)}
  1694. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1695. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1696. {$IFEND}
  1697. glEnable := glbGetProcAddress('glEnable');
  1698. glDisable := glbGetProcAddress('glDisable');
  1699. glGetString := glbGetProcAddress('glGetString');
  1700. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1701. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1702. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1703. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1704. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1705. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1706. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1707. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1708. glTexGeni := glbGetProcAddress('glTexGeni');
  1709. glGenTextures := glbGetProcAddress('glGenTextures');
  1710. glBindTexture := glbGetProcAddress('glBindTexture');
  1711. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1712. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1713. glReadPixels := glbGetProcAddress('glReadPixels');
  1714. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1715. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1716. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1717. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1718. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1719. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1720. end;
  1721. {$ENDIF}
  1722. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1723. procedure glbReadOpenGLExtensions;
  1724. var
  1725. Buffer: AnsiString;
  1726. MajorVersion, MinorVersion: Integer;
  1727. ///////////////////////////////////////////////////////////////////////////////////////////
  1728. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1729. var
  1730. Separator: Integer;
  1731. begin
  1732. aMinor := 0;
  1733. aMajor := 0;
  1734. Separator := Pos(AnsiString('.'), aBuffer);
  1735. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1736. (aBuffer[Separator - 1] in ['0'..'9']) and
  1737. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1738. Dec(Separator);
  1739. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1740. Dec(Separator);
  1741. Delete(aBuffer, 1, Separator);
  1742. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1743. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1744. Inc(Separator);
  1745. Delete(aBuffer, Separator, 255);
  1746. Separator := Pos(AnsiString('.'), aBuffer);
  1747. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1748. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1749. end;
  1750. end;
  1751. ///////////////////////////////////////////////////////////////////////////////////////////
  1752. function CheckExtension(const Extension: AnsiString): Boolean;
  1753. var
  1754. ExtPos: Integer;
  1755. begin
  1756. ExtPos := Pos(Extension, Buffer);
  1757. result := ExtPos > 0;
  1758. if result then
  1759. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1760. end;
  1761. ///////////////////////////////////////////////////////////////////////////////////////////
  1762. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1763. begin
  1764. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1765. end;
  1766. begin
  1767. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1768. InitOpenGLCS.Enter;
  1769. try
  1770. if not OpenGLInitialized then begin
  1771. glbInitOpenGL;
  1772. OpenGLInitialized := true;
  1773. end;
  1774. finally
  1775. InitOpenGLCS.Leave;
  1776. end;
  1777. {$ENDIF}
  1778. // Version
  1779. Buffer := glGetString(GL_VERSION);
  1780. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1781. GL_VERSION_1_2 := CheckVersion(1, 2);
  1782. GL_VERSION_1_3 := CheckVersion(1, 3);
  1783. GL_VERSION_1_4 := CheckVersion(1, 4);
  1784. GL_VERSION_2_0 := CheckVersion(2, 0);
  1785. GL_VERSION_3_3 := CheckVersion(3, 3);
  1786. // Extensions
  1787. Buffer := glGetString(GL_EXTENSIONS);
  1788. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1789. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1790. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1791. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1792. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1793. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1794. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1795. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1796. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1797. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1798. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1799. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1800. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1801. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1802. if GL_VERSION_1_3 then begin
  1803. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1804. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1805. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1806. end else begin
  1807. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false);
  1808. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false);
  1809. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
  1810. end;
  1811. end;
  1812. {$ENDIF}
  1813. {$IFDEF GLB_SDL_IMAGE}
  1814. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1815. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1816. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1817. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1818. begin
  1819. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1820. end;
  1821. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1822. begin
  1823. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1824. end;
  1825. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1826. begin
  1827. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1828. end;
  1829. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1830. begin
  1831. result := 0;
  1832. end;
  1833. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1834. begin
  1835. result := SDL_AllocRW;
  1836. if result = nil then
  1837. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1838. result^.seek := glBitmapRWseek;
  1839. result^.read := glBitmapRWread;
  1840. result^.write := glBitmapRWwrite;
  1841. result^.close := glBitmapRWclose;
  1842. result^.unknown.data1 := Stream;
  1843. end;
  1844. {$ENDIF}
  1845. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1846. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1847. begin
  1848. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1849. end;
  1850. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1851. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1852. begin
  1853. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1854. end;
  1855. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1856. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1857. begin
  1858. glBitmapDefaultMipmap := aValue;
  1859. end;
  1860. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1861. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1862. begin
  1863. glBitmapDefaultFormat := aFormat;
  1864. end;
  1865. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1866. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1867. begin
  1868. glBitmapDefaultFilterMin := aMin;
  1869. glBitmapDefaultFilterMag := aMag;
  1870. end;
  1871. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1872. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1873. begin
  1874. glBitmapDefaultWrapS := S;
  1875. glBitmapDefaultWrapT := T;
  1876. glBitmapDefaultWrapR := R;
  1877. end;
  1878. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1879. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1880. begin
  1881. glDefaultSwizzle[0] := r;
  1882. glDefaultSwizzle[1] := g;
  1883. glDefaultSwizzle[2] := b;
  1884. glDefaultSwizzle[3] := a;
  1885. end;
  1886. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1887. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1888. begin
  1889. result := glBitmapDefaultDeleteTextureOnFree;
  1890. end;
  1891. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1892. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1893. begin
  1894. result := glBitmapDefaultFreeDataAfterGenTextures;
  1895. end;
  1896. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1897. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1898. begin
  1899. result := glBitmapDefaultMipmap;
  1900. end;
  1901. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1902. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1903. begin
  1904. result := glBitmapDefaultFormat;
  1905. end;
  1906. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1907. procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
  1908. begin
  1909. aMin := glBitmapDefaultFilterMin;
  1910. aMag := glBitmapDefaultFilterMag;
  1911. end;
  1912. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1913. procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
  1914. begin
  1915. S := glBitmapDefaultWrapS;
  1916. T := glBitmapDefaultWrapT;
  1917. R := glBitmapDefaultWrapR;
  1918. end;
  1919. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1920. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1921. begin
  1922. r := glDefaultSwizzle[0];
  1923. g := glDefaultSwizzle[1];
  1924. b := glDefaultSwizzle[2];
  1925. a := glDefaultSwizzle[3];
  1926. end;
  1927. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1928. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1929. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1930. function TFormatDescriptor.GetRedMask: QWord;
  1931. begin
  1932. result := fRange.r shl fShift.r;
  1933. end;
  1934. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1935. function TFormatDescriptor.GetGreenMask: QWord;
  1936. begin
  1937. result := fRange.g shl fShift.g;
  1938. end;
  1939. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1940. function TFormatDescriptor.GetBlueMask: QWord;
  1941. begin
  1942. result := fRange.b shl fShift.b;
  1943. end;
  1944. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1945. function TFormatDescriptor.GetAlphaMask: QWord;
  1946. begin
  1947. result := fRange.a shl fShift.a;
  1948. end;
  1949. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1950. function TFormatDescriptor.GetIsCompressed: Boolean;
  1951. begin
  1952. result := fIsCompressed;
  1953. end;
  1954. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1955. function TFormatDescriptor.GetHasAlpha: Boolean;
  1956. begin
  1957. result := (fRange.a > 0);
  1958. end;
  1959. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1960. function TFormatDescriptor.GetglFormat: GLenum;
  1961. begin
  1962. result := fglFormat;
  1963. end;
  1964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1965. function TFormatDescriptor.GetglInternalFormat: GLenum;
  1966. begin
  1967. result := fglInternalFormat;
  1968. end;
  1969. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1970. function TFormatDescriptor.GetglDataFormat: GLenum;
  1971. begin
  1972. result := fglDataFormat;
  1973. end;
  1974. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1975. function TFormatDescriptor.GetComponents: Integer;
  1976. var
  1977. i: Integer;
  1978. begin
  1979. result := 0;
  1980. for i := 0 to 3 do
  1981. if (fRange.arr[i] > 0) then
  1982. inc(result);
  1983. end;
  1984. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1985. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  1986. var
  1987. w, h: Integer;
  1988. begin
  1989. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  1990. w := Max(1, aSize.X);
  1991. h := Max(1, aSize.Y);
  1992. result := GetSize(w, h);
  1993. end else
  1994. result := 0;
  1995. end;
  1996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1997. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  1998. begin
  1999. result := 0;
  2000. if (aWidth <= 0) or (aHeight <= 0) then
  2001. exit;
  2002. result := Ceil(aWidth * aHeight * fPixelSize);
  2003. end;
  2004. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2005. function TFormatDescriptor.CreateMappingData: Pointer;
  2006. begin
  2007. result := nil;
  2008. end;
  2009. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2010. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2011. begin
  2012. //DUMMY
  2013. end;
  2014. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2015. function TFormatDescriptor.IsEmpty: Boolean;
  2016. begin
  2017. result := (fFormat = tfEmpty);
  2018. end;
  2019. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2020. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  2021. begin
  2022. result := false;
  2023. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2024. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2025. if (aRedMask <> RedMask) then
  2026. exit;
  2027. if (aGreenMask <> GreenMask) then
  2028. exit;
  2029. if (aBlueMask <> BlueMask) then
  2030. exit;
  2031. if (aAlphaMask <> AlphaMask) then
  2032. exit;
  2033. result := true;
  2034. end;
  2035. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2036. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2037. begin
  2038. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2039. aPixel.Data := fRange;
  2040. aPixel.Range := fRange;
  2041. aPixel.Format := fFormat;
  2042. end;
  2043. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2044. constructor TFormatDescriptor.Create;
  2045. begin
  2046. inherited Create;
  2047. fFormat := tfEmpty;
  2048. fWithAlpha := tfEmpty;
  2049. fWithoutAlpha := tfEmpty;
  2050. fRGBInverted := tfEmpty;
  2051. fUncompressed := tfEmpty;
  2052. fPixelSize := 0.0;
  2053. fIsCompressed := false;
  2054. fglFormat := 0;
  2055. fglInternalFormat := 0;
  2056. fglDataFormat := 0;
  2057. FillChar(fRange, 0, SizeOf(fRange));
  2058. FillChar(fShift, 0, SizeOf(fShift));
  2059. end;
  2060. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2061. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2062. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2063. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2064. begin
  2065. aData^ := aPixel.Data.a;
  2066. inc(aData);
  2067. end;
  2068. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2069. begin
  2070. aPixel.Data.r := 0;
  2071. aPixel.Data.g := 0;
  2072. aPixel.Data.b := 0;
  2073. aPixel.Data.a := aData^;
  2074. inc(aData);
  2075. end;
  2076. constructor TfdAlpha_UB1.Create;
  2077. begin
  2078. inherited Create;
  2079. fPixelSize := 1.0;
  2080. fRange.a := $FF;
  2081. fglFormat := GL_ALPHA;
  2082. fglDataFormat := GL_UNSIGNED_BYTE;
  2083. end;
  2084. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2085. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2086. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2087. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2088. begin
  2089. aData^ := LuminanceWeight(aPixel);
  2090. inc(aData);
  2091. end;
  2092. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2093. begin
  2094. aPixel.Data.r := aData^;
  2095. aPixel.Data.g := aData^;
  2096. aPixel.Data.b := aData^;
  2097. aPixel.Data.a := 0;
  2098. inc(aData);
  2099. end;
  2100. constructor TfdLuminance_UB1.Create;
  2101. begin
  2102. inherited Create;
  2103. fPixelSize := 1.0;
  2104. fRange.r := $FF;
  2105. fRange.g := $FF;
  2106. fRange.b := $FF;
  2107. fglFormat := GL_LUMINANCE;
  2108. fglDataFormat := GL_UNSIGNED_BYTE;
  2109. end;
  2110. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2111. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2112. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2113. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2114. var
  2115. i: Integer;
  2116. begin
  2117. aData^ := 0;
  2118. for i := 0 to 3 do
  2119. if (fRange.arr[i] > 0) then
  2120. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2121. inc(aData);
  2122. end;
  2123. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2124. var
  2125. i: Integer;
  2126. begin
  2127. for i := 0 to 3 do
  2128. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2129. inc(aData);
  2130. end;
  2131. constructor TfdUniversal_UB1.Create;
  2132. begin
  2133. inherited Create;
  2134. fPixelSize := 1.0;
  2135. end;
  2136. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2137. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2138. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2139. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2140. begin
  2141. inherited Map(aPixel, aData, aMapData);
  2142. aData^ := aPixel.Data.a;
  2143. inc(aData);
  2144. end;
  2145. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2146. begin
  2147. inherited Unmap(aData, aPixel, aMapData);
  2148. aPixel.Data.a := aData^;
  2149. inc(aData);
  2150. end;
  2151. constructor TfdLuminanceAlpha_UB2.Create;
  2152. begin
  2153. inherited Create;
  2154. fPixelSize := 2.0;
  2155. fRange.a := $FF;
  2156. fShift.a := 8;
  2157. fglFormat := GL_LUMINANCE_ALPHA;
  2158. fglDataFormat := GL_UNSIGNED_BYTE;
  2159. end;
  2160. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2161. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2162. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2163. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2164. begin
  2165. aData^ := aPixel.Data.r;
  2166. inc(aData);
  2167. aData^ := aPixel.Data.g;
  2168. inc(aData);
  2169. aData^ := aPixel.Data.b;
  2170. inc(aData);
  2171. end;
  2172. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2173. begin
  2174. aPixel.Data.r := aData^;
  2175. inc(aData);
  2176. aPixel.Data.g := aData^;
  2177. inc(aData);
  2178. aPixel.Data.b := aData^;
  2179. inc(aData);
  2180. aPixel.Data.a := 0;
  2181. end;
  2182. constructor TfdRGB_UB3.Create;
  2183. begin
  2184. inherited Create;
  2185. fPixelSize := 3.0;
  2186. fRange.r := $FF;
  2187. fRange.g := $FF;
  2188. fRange.b := $FF;
  2189. fShift.r := 0;
  2190. fShift.g := 8;
  2191. fShift.b := 16;
  2192. fglFormat := GL_RGB;
  2193. fglDataFormat := GL_UNSIGNED_BYTE;
  2194. end;
  2195. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2196. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2197. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2198. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2199. begin
  2200. aData^ := aPixel.Data.b;
  2201. inc(aData);
  2202. aData^ := aPixel.Data.g;
  2203. inc(aData);
  2204. aData^ := aPixel.Data.r;
  2205. inc(aData);
  2206. end;
  2207. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2208. begin
  2209. aPixel.Data.b := aData^;
  2210. inc(aData);
  2211. aPixel.Data.g := aData^;
  2212. inc(aData);
  2213. aPixel.Data.r := aData^;
  2214. inc(aData);
  2215. aPixel.Data.a := 0;
  2216. end;
  2217. constructor TfdBGR_UB3.Create;
  2218. begin
  2219. fPixelSize := 3.0;
  2220. fRange.r := $FF;
  2221. fRange.g := $FF;
  2222. fRange.b := $FF;
  2223. fShift.r := 16;
  2224. fShift.g := 8;
  2225. fShift.b := 0;
  2226. fglFormat := GL_BGR;
  2227. fglDataFormat := GL_UNSIGNED_BYTE;
  2228. end;
  2229. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2230. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2231. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2232. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2233. begin
  2234. inherited Map(aPixel, aData, aMapData);
  2235. aData^ := aPixel.Data.a;
  2236. inc(aData);
  2237. end;
  2238. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2239. begin
  2240. inherited Unmap(aData, aPixel, aMapData);
  2241. aPixel.Data.a := aData^;
  2242. inc(aData);
  2243. end;
  2244. constructor TfdRGBA_UB4.Create;
  2245. begin
  2246. inherited Create;
  2247. fPixelSize := 4.0;
  2248. fRange.a := $FF;
  2249. fShift.a := 24;
  2250. fglFormat := GL_RGBA;
  2251. fglDataFormat := GL_UNSIGNED_BYTE;
  2252. end;
  2253. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2254. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2255. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2256. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2257. begin
  2258. inherited Map(aPixel, aData, aMapData);
  2259. aData^ := aPixel.Data.a;
  2260. inc(aData);
  2261. end;
  2262. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2263. begin
  2264. inherited Unmap(aData, aPixel, aMapData);
  2265. aPixel.Data.a := aData^;
  2266. inc(aData);
  2267. end;
  2268. constructor TfdBGRA_UB4.Create;
  2269. begin
  2270. inherited Create;
  2271. fPixelSize := 4.0;
  2272. fRange.a := $FF;
  2273. fShift.a := 24;
  2274. fglFormat := GL_BGRA;
  2275. fglDataFormat := GL_UNSIGNED_BYTE;
  2276. end;
  2277. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2278. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2279. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2280. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2281. begin
  2282. PWord(aData)^ := aPixel.Data.a;
  2283. inc(aData, 2);
  2284. end;
  2285. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2286. begin
  2287. aPixel.Data.r := 0;
  2288. aPixel.Data.g := 0;
  2289. aPixel.Data.b := 0;
  2290. aPixel.Data.a := PWord(aData)^;
  2291. inc(aData, 2);
  2292. end;
  2293. constructor TfdAlpha_US1.Create;
  2294. begin
  2295. inherited Create;
  2296. fPixelSize := 2.0;
  2297. fRange.a := $FFFF;
  2298. fglFormat := GL_ALPHA;
  2299. fglDataFormat := GL_UNSIGNED_SHORT;
  2300. end;
  2301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2302. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2303. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2304. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2305. begin
  2306. PWord(aData)^ := LuminanceWeight(aPixel);
  2307. inc(aData, 2);
  2308. end;
  2309. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2310. begin
  2311. aPixel.Data.r := PWord(aData)^;
  2312. aPixel.Data.g := PWord(aData)^;
  2313. aPixel.Data.b := PWord(aData)^;
  2314. aPixel.Data.a := 0;
  2315. inc(aData, 2);
  2316. end;
  2317. constructor TfdLuminance_US1.Create;
  2318. begin
  2319. inherited Create;
  2320. fPixelSize := 2.0;
  2321. fRange.r := $FFFF;
  2322. fRange.g := $FFFF;
  2323. fRange.b := $FFFF;
  2324. fglFormat := GL_LUMINANCE;
  2325. fglDataFormat := GL_UNSIGNED_SHORT;
  2326. end;
  2327. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2328. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2329. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2330. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2331. var
  2332. i: Integer;
  2333. begin
  2334. PWord(aData)^ := 0;
  2335. for i := 0 to 3 do
  2336. if (fRange.arr[i] > 0) then
  2337. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2338. inc(aData, 2);
  2339. end;
  2340. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2341. var
  2342. i: Integer;
  2343. begin
  2344. for i := 0 to 3 do
  2345. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2346. inc(aData, 2);
  2347. end;
  2348. constructor TfdUniversal_US1.Create;
  2349. begin
  2350. inherited Create;
  2351. fPixelSize := 2.0;
  2352. end;
  2353. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2354. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2355. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2356. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2357. begin
  2358. PWord(aData)^ := DepthWeight(aPixel);
  2359. inc(aData, 2);
  2360. end;
  2361. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2362. begin
  2363. aPixel.Data.r := PWord(aData)^;
  2364. aPixel.Data.g := PWord(aData)^;
  2365. aPixel.Data.b := PWord(aData)^;
  2366. aPixel.Data.a := 0;
  2367. inc(aData, 2);
  2368. end;
  2369. constructor TfdDepth_US1.Create;
  2370. begin
  2371. inherited Create;
  2372. fPixelSize := 2.0;
  2373. fRange.r := $FFFF;
  2374. fRange.g := $FFFF;
  2375. fRange.b := $FFFF;
  2376. fglFormat := GL_DEPTH_COMPONENT;
  2377. fglDataFormat := GL_UNSIGNED_SHORT;
  2378. end;
  2379. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2380. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2381. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2382. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2383. begin
  2384. inherited Map(aPixel, aData, aMapData);
  2385. PWord(aData)^ := aPixel.Data.a;
  2386. inc(aData, 2);
  2387. end;
  2388. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2389. begin
  2390. inherited Unmap(aData, aPixel, aMapData);
  2391. aPixel.Data.a := PWord(aData)^;
  2392. inc(aData, 2);
  2393. end;
  2394. constructor TfdLuminanceAlpha_US2.Create;
  2395. begin
  2396. inherited Create;
  2397. fPixelSize := 4.0;
  2398. fRange.a := $FFFF;
  2399. fShift.a := 16;
  2400. fglFormat := GL_LUMINANCE_ALPHA;
  2401. fglDataFormat := GL_UNSIGNED_SHORT;
  2402. end;
  2403. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2404. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2405. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2406. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2407. begin
  2408. PWord(aData)^ := aPixel.Data.r;
  2409. inc(aData, 2);
  2410. PWord(aData)^ := aPixel.Data.g;
  2411. inc(aData, 2);
  2412. PWord(aData)^ := aPixel.Data.b;
  2413. inc(aData, 2);
  2414. end;
  2415. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2416. begin
  2417. aPixel.Data.r := PWord(aData)^;
  2418. inc(aData, 2);
  2419. aPixel.Data.g := PWord(aData)^;
  2420. inc(aData, 2);
  2421. aPixel.Data.b := PWord(aData)^;
  2422. inc(aData, 2);
  2423. aPixel.Data.a := 0;
  2424. end;
  2425. constructor TfdRGB_US3.Create;
  2426. begin
  2427. inherited Create;
  2428. fPixelSize := 6.0;
  2429. fRange.r := $FFFF;
  2430. fRange.g := $FFFF;
  2431. fRange.b := $FFFF;
  2432. fShift.r := 0;
  2433. fShift.g := 16;
  2434. fShift.b := 32;
  2435. fglFormat := GL_RGB;
  2436. fglDataFormat := GL_UNSIGNED_SHORT;
  2437. end;
  2438. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2439. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2440. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2441. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2442. begin
  2443. PWord(aData)^ := aPixel.Data.b;
  2444. inc(aData, 2);
  2445. PWord(aData)^ := aPixel.Data.g;
  2446. inc(aData, 2);
  2447. PWord(aData)^ := aPixel.Data.r;
  2448. inc(aData, 2);
  2449. end;
  2450. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2451. begin
  2452. aPixel.Data.b := PWord(aData)^;
  2453. inc(aData, 2);
  2454. aPixel.Data.g := PWord(aData)^;
  2455. inc(aData, 2);
  2456. aPixel.Data.r := PWord(aData)^;
  2457. inc(aData, 2);
  2458. aPixel.Data.a := 0;
  2459. end;
  2460. constructor TfdBGR_US3.Create;
  2461. begin
  2462. inherited Create;
  2463. fPixelSize := 6.0;
  2464. fRange.r := $FFFF;
  2465. fRange.g := $FFFF;
  2466. fRange.b := $FFFF;
  2467. fShift.r := 32;
  2468. fShift.g := 16;
  2469. fShift.b := 0;
  2470. fglFormat := GL_BGR;
  2471. fglDataFormat := GL_UNSIGNED_SHORT;
  2472. end;
  2473. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2474. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2475. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2476. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2477. begin
  2478. inherited Map(aPixel, aData, aMapData);
  2479. PWord(aData)^ := aPixel.Data.a;
  2480. inc(aData, 2);
  2481. end;
  2482. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2483. begin
  2484. inherited Unmap(aData, aPixel, aMapData);
  2485. aPixel.Data.a := PWord(aData)^;
  2486. inc(aData, 2);
  2487. end;
  2488. constructor TfdRGBA_US4.Create;
  2489. begin
  2490. inherited Create;
  2491. fPixelSize := 8.0;
  2492. fRange.a := $FFFF;
  2493. fShift.a := 48;
  2494. fglFormat := GL_RGBA;
  2495. fglDataFormat := GL_UNSIGNED_SHORT;
  2496. end;
  2497. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2498. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2499. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2500. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2501. begin
  2502. inherited Map(aPixel, aData, aMapData);
  2503. PWord(aData)^ := aPixel.Data.a;
  2504. inc(aData, 2);
  2505. end;
  2506. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2507. begin
  2508. inherited Unmap(aData, aPixel, aMapData);
  2509. aPixel.Data.a := PWord(aData)^;
  2510. inc(aData, 2);
  2511. end;
  2512. constructor TfdBGRA_US4.Create;
  2513. begin
  2514. inherited Create;
  2515. fPixelSize := 8.0;
  2516. fRange.a := $FFFF;
  2517. fShift.a := 48;
  2518. fglFormat := GL_BGRA;
  2519. fglDataFormat := GL_UNSIGNED_SHORT;
  2520. end;
  2521. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2522. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2523. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2524. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2525. var
  2526. i: Integer;
  2527. begin
  2528. PCardinal(aData)^ := 0;
  2529. for i := 0 to 3 do
  2530. if (fRange.arr[i] > 0) then
  2531. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2532. inc(aData, 4);
  2533. end;
  2534. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2535. var
  2536. i: Integer;
  2537. begin
  2538. for i := 0 to 3 do
  2539. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2540. inc(aData, 2);
  2541. end;
  2542. constructor TfdUniversal_UI1.Create;
  2543. begin
  2544. inherited Create;
  2545. fPixelSize := 4.0;
  2546. end;
  2547. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2548. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2549. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2550. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2551. begin
  2552. PCardinal(aData)^ := DepthWeight(aPixel);
  2553. inc(aData, 4);
  2554. end;
  2555. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2556. begin
  2557. aPixel.Data.r := PCardinal(aData)^;
  2558. aPixel.Data.g := PCardinal(aData)^;
  2559. aPixel.Data.b := PCardinal(aData)^;
  2560. aPixel.Data.a := 0;
  2561. inc(aData, 4);
  2562. end;
  2563. constructor TfdDepth_UI1.Create;
  2564. begin
  2565. inherited Create;
  2566. fPixelSize := 4.0;
  2567. fRange.r := $FFFFFFFF;
  2568. fRange.g := $FFFFFFFF;
  2569. fRange.b := $FFFFFFFF;
  2570. fglFormat := GL_DEPTH_COMPONENT;
  2571. fglDataFormat := GL_UNSIGNED_INT;
  2572. end;
  2573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2574. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2575. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2576. constructor TfdAlpha4.Create;
  2577. begin
  2578. inherited Create;
  2579. fFormat := tfAlpha4;
  2580. fWithAlpha := tfAlpha4;
  2581. fglInternalFormat := GL_ALPHA4;
  2582. end;
  2583. constructor TfdAlpha8.Create;
  2584. begin
  2585. inherited Create;
  2586. fFormat := tfAlpha8;
  2587. fWithAlpha := tfAlpha8;
  2588. fglInternalFormat := GL_ALPHA8;
  2589. end;
  2590. constructor TfdAlpha12.Create;
  2591. begin
  2592. inherited Create;
  2593. fFormat := tfAlpha12;
  2594. fWithAlpha := tfAlpha12;
  2595. fglInternalFormat := GL_ALPHA12;
  2596. end;
  2597. constructor TfdAlpha16.Create;
  2598. begin
  2599. inherited Create;
  2600. fFormat := tfAlpha16;
  2601. fWithAlpha := tfAlpha16;
  2602. fglInternalFormat := GL_ALPHA16;
  2603. end;
  2604. constructor TfdLuminance4.Create;
  2605. begin
  2606. inherited Create;
  2607. fFormat := tfLuminance4;
  2608. fWithAlpha := tfLuminance4Alpha4;
  2609. fWithoutAlpha := tfLuminance4;
  2610. fglInternalFormat := GL_LUMINANCE4;
  2611. end;
  2612. constructor TfdLuminance8.Create;
  2613. begin
  2614. inherited Create;
  2615. fFormat := tfLuminance8;
  2616. fWithAlpha := tfLuminance8Alpha8;
  2617. fWithoutAlpha := tfLuminance8;
  2618. fglInternalFormat := GL_LUMINANCE8;
  2619. end;
  2620. constructor TfdLuminance12.Create;
  2621. begin
  2622. inherited Create;
  2623. fFormat := tfLuminance12;
  2624. fWithAlpha := tfLuminance12Alpha12;
  2625. fWithoutAlpha := tfLuminance12;
  2626. fglInternalFormat := GL_LUMINANCE12;
  2627. end;
  2628. constructor TfdLuminance16.Create;
  2629. begin
  2630. inherited Create;
  2631. fFormat := tfLuminance16;
  2632. fWithAlpha := tfLuminance16Alpha16;
  2633. fWithoutAlpha := tfLuminance16;
  2634. fglInternalFormat := GL_LUMINANCE16;
  2635. end;
  2636. constructor TfdLuminance4Alpha4.Create;
  2637. begin
  2638. inherited Create;
  2639. fFormat := tfLuminance4Alpha4;
  2640. fWithAlpha := tfLuminance4Alpha4;
  2641. fWithoutAlpha := tfLuminance4;
  2642. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2643. end;
  2644. constructor TfdLuminance6Alpha2.Create;
  2645. begin
  2646. inherited Create;
  2647. fFormat := tfLuminance6Alpha2;
  2648. fWithAlpha := tfLuminance6Alpha2;
  2649. fWithoutAlpha := tfLuminance8;
  2650. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2651. end;
  2652. constructor TfdLuminance8Alpha8.Create;
  2653. begin
  2654. inherited Create;
  2655. fFormat := tfLuminance8Alpha8;
  2656. fWithAlpha := tfLuminance8Alpha8;
  2657. fWithoutAlpha := tfLuminance8;
  2658. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2659. end;
  2660. constructor TfdLuminance12Alpha4.Create;
  2661. begin
  2662. inherited Create;
  2663. fFormat := tfLuminance12Alpha4;
  2664. fWithAlpha := tfLuminance12Alpha4;
  2665. fWithoutAlpha := tfLuminance12;
  2666. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2667. end;
  2668. constructor TfdLuminance12Alpha12.Create;
  2669. begin
  2670. inherited Create;
  2671. fFormat := tfLuminance12Alpha12;
  2672. fWithAlpha := tfLuminance12Alpha12;
  2673. fWithoutAlpha := tfLuminance12;
  2674. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2675. end;
  2676. constructor TfdLuminance16Alpha16.Create;
  2677. begin
  2678. inherited Create;
  2679. fFormat := tfLuminance16Alpha16;
  2680. fWithAlpha := tfLuminance16Alpha16;
  2681. fWithoutAlpha := tfLuminance16;
  2682. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2683. end;
  2684. constructor TfdR3G3B2.Create;
  2685. begin
  2686. inherited Create;
  2687. fFormat := tfR3G3B2;
  2688. fWithAlpha := tfRGBA2;
  2689. fWithoutAlpha := tfR3G3B2;
  2690. fRange.r := $7;
  2691. fRange.g := $7;
  2692. fRange.b := $3;
  2693. fShift.r := 0;
  2694. fShift.g := 3;
  2695. fShift.b := 6;
  2696. fglFormat := GL_RGB;
  2697. fglInternalFormat := GL_R3_G3_B2;
  2698. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2699. end;
  2700. constructor TfdRGB4.Create;
  2701. begin
  2702. inherited Create;
  2703. fFormat := tfRGB4;
  2704. fWithAlpha := tfRGBA4;
  2705. fWithoutAlpha := tfRGB4;
  2706. fRGBInverted := tfBGR4;
  2707. fRange.r := $F;
  2708. fRange.g := $F;
  2709. fRange.b := $F;
  2710. fShift.r := 0;
  2711. fShift.g := 4;
  2712. fShift.b := 8;
  2713. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2714. fglInternalFormat := GL_RGB4;
  2715. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2716. end;
  2717. constructor TfdR5G6B5.Create;
  2718. begin
  2719. inherited Create;
  2720. fFormat := tfR5G6B5;
  2721. fWithAlpha := tfRGBA4;
  2722. fWithoutAlpha := tfR5G6B5;
  2723. fRGBInverted := tfB5G6R5;
  2724. fRange.r := $1F;
  2725. fRange.g := $3F;
  2726. fRange.b := $1F;
  2727. fShift.r := 0;
  2728. fShift.g := 5;
  2729. fShift.b := 11;
  2730. fglFormat := GL_RGB;
  2731. fglInternalFormat := GL_RGB565;
  2732. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2733. end;
  2734. constructor TfdRGB5.Create;
  2735. begin
  2736. inherited Create;
  2737. fFormat := tfRGB5;
  2738. fWithAlpha := tfRGB5A1;
  2739. fWithoutAlpha := tfRGB5;
  2740. fRGBInverted := tfBGR5;
  2741. fRange.r := $1F;
  2742. fRange.g := $1F;
  2743. fRange.b := $1F;
  2744. fShift.r := 0;
  2745. fShift.g := 5;
  2746. fShift.b := 10;
  2747. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2748. fglInternalFormat := GL_RGB5;
  2749. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2750. end;
  2751. constructor TfdRGB8.Create;
  2752. begin
  2753. inherited Create;
  2754. fFormat := tfRGB8;
  2755. fWithAlpha := tfRGBA8;
  2756. fWithoutAlpha := tfRGB8;
  2757. fRGBInverted := tfBGR8;
  2758. fglInternalFormat := GL_RGB8;
  2759. end;
  2760. constructor TfdRGB10.Create;
  2761. begin
  2762. inherited Create;
  2763. fFormat := tfRGB10;
  2764. fWithAlpha := tfRGB10A2;
  2765. fWithoutAlpha := tfRGB10;
  2766. fRGBInverted := tfBGR10;
  2767. fRange.r := $3FF;
  2768. fRange.g := $3FF;
  2769. fRange.b := $3FF;
  2770. fShift.r := 0;
  2771. fShift.g := 10;
  2772. fShift.b := 20;
  2773. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2774. fglInternalFormat := GL_RGB10;
  2775. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2776. end;
  2777. constructor TfdRGB12.Create;
  2778. begin
  2779. inherited Create;
  2780. fFormat := tfRGB12;
  2781. fWithAlpha := tfRGBA12;
  2782. fWithoutAlpha := tfRGB12;
  2783. fRGBInverted := tfBGR12;
  2784. fglInternalFormat := GL_RGB12;
  2785. end;
  2786. constructor TfdRGB16.Create;
  2787. begin
  2788. inherited Create;
  2789. fFormat := tfRGB16;
  2790. fWithAlpha := tfRGBA16;
  2791. fWithoutAlpha := tfRGB16;
  2792. fRGBInverted := tfBGR16;
  2793. fglInternalFormat := GL_RGB16;
  2794. end;
  2795. constructor TfdRGBA2.Create;
  2796. begin
  2797. inherited Create;
  2798. fFormat := tfRGBA2;
  2799. fWithAlpha := tfRGBA2;
  2800. fWithoutAlpha := tfR3G3B2;
  2801. fRGBInverted := tfBGRA2;
  2802. fglInternalFormat := GL_RGBA2;
  2803. end;
  2804. constructor TfdRGBA4.Create;
  2805. begin
  2806. inherited Create;
  2807. fFormat := tfRGBA4;
  2808. fWithAlpha := tfRGBA4;
  2809. fWithoutAlpha := tfRGB4;
  2810. fRGBInverted := tfBGRA4;
  2811. fRange.r := $F;
  2812. fRange.g := $F;
  2813. fRange.b := $F;
  2814. fRange.a := $F;
  2815. fShift.r := 0;
  2816. fShift.g := 4;
  2817. fShift.b := 8;
  2818. fShift.a := 12;
  2819. fglFormat := GL_RGBA;
  2820. fglInternalFormat := GL_RGBA4;
  2821. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2822. end;
  2823. constructor TfdRGB5A1.Create;
  2824. begin
  2825. inherited Create;
  2826. fFormat := tfRGB5A1;
  2827. fWithAlpha := tfRGB5A1;
  2828. fWithoutAlpha := tfRGB5;
  2829. fRGBInverted := tfBGR5A1;
  2830. fRange.r := $1F;
  2831. fRange.g := $1F;
  2832. fRange.b := $1F;
  2833. fRange.a := $01;
  2834. fShift.r := 0;
  2835. fShift.g := 5;
  2836. fShift.b := 10;
  2837. fShift.a := 15;
  2838. fglFormat := GL_RGBA;
  2839. fglInternalFormat := GL_RGB5_A1;
  2840. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2841. end;
  2842. constructor TfdRGBA8.Create;
  2843. begin
  2844. inherited Create;
  2845. fFormat := tfRGBA8;
  2846. fWithAlpha := tfRGBA8;
  2847. fWithoutAlpha := tfRGB8;
  2848. fRGBInverted := tfBGRA8;
  2849. fglInternalFormat := GL_RGBA8;
  2850. end;
  2851. constructor TfdRGB10A2.Create;
  2852. begin
  2853. inherited Create;
  2854. fFormat := tfRGB10A2;
  2855. fWithAlpha := tfRGB10A2;
  2856. fWithoutAlpha := tfRGB10;
  2857. fRGBInverted := tfBGR10A2;
  2858. fRange.r := $3FF;
  2859. fRange.g := $3FF;
  2860. fRange.b := $3FF;
  2861. fRange.a := $003;
  2862. fShift.r := 0;
  2863. fShift.g := 10;
  2864. fShift.b := 20;
  2865. fShift.a := 30;
  2866. fglFormat := GL_RGBA;
  2867. fglInternalFormat := GL_RGB10_A2;
  2868. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2869. end;
  2870. constructor TfdRGBA12.Create;
  2871. begin
  2872. inherited Create;
  2873. fFormat := tfRGBA12;
  2874. fWithAlpha := tfRGBA12;
  2875. fWithoutAlpha := tfRGB12;
  2876. fRGBInverted := tfBGRA12;
  2877. fglInternalFormat := GL_RGBA12;
  2878. end;
  2879. constructor TfdRGBA16.Create;
  2880. begin
  2881. inherited Create;
  2882. fFormat := tfRGBA16;
  2883. fWithAlpha := tfRGBA16;
  2884. fWithoutAlpha := tfRGB16;
  2885. fRGBInverted := tfBGRA16;
  2886. fglInternalFormat := GL_RGBA16;
  2887. end;
  2888. constructor TfdBGR4.Create;
  2889. begin
  2890. inherited Create;
  2891. fPixelSize := 2.0;
  2892. fFormat := tfBGR4;
  2893. fWithAlpha := tfBGRA4;
  2894. fWithoutAlpha := tfBGR4;
  2895. fRGBInverted := tfRGB4;
  2896. fRange.r := $F;
  2897. fRange.g := $F;
  2898. fRange.b := $F;
  2899. fRange.a := $0;
  2900. fShift.r := 8;
  2901. fShift.g := 4;
  2902. fShift.b := 0;
  2903. fShift.a := 0;
  2904. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2905. fglInternalFormat := GL_RGB4;
  2906. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2907. end;
  2908. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2909. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2910. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2911. constructor TfdB5G6R5.Create;
  2912. begin
  2913. inherited Create;
  2914. fFormat := tfB5G6R5;
  2915. fWithAlpha := tfBGRA4;
  2916. fWithoutAlpha := tfB5G6R5;
  2917. fRGBInverted := tfR5G6B5;
  2918. fRange.r := $1F;
  2919. fRange.g := $3F;
  2920. fRange.b := $1F;
  2921. fShift.r := 11;
  2922. fShift.g := 5;
  2923. fShift.b := 0;
  2924. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2925. fglInternalFormat := GL_RGB8;
  2926. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2927. end;
  2928. constructor TfdBGR5.Create;
  2929. begin
  2930. inherited Create;
  2931. fPixelSize := 2.0;
  2932. fFormat := tfBGR5;
  2933. fWithAlpha := tfBGR5A1;
  2934. fWithoutAlpha := tfBGR5;
  2935. fRGBInverted := tfRGB5;
  2936. fRange.r := $1F;
  2937. fRange.g := $1F;
  2938. fRange.b := $1F;
  2939. fRange.a := $00;
  2940. fShift.r := 10;
  2941. fShift.g := 5;
  2942. fShift.b := 0;
  2943. fShift.a := 0;
  2944. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2945. fglInternalFormat := GL_RGB5;
  2946. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2947. end;
  2948. constructor TfdBGR8.Create;
  2949. begin
  2950. inherited Create;
  2951. fFormat := tfBGR8;
  2952. fWithAlpha := tfBGRA8;
  2953. fWithoutAlpha := tfBGR8;
  2954. fRGBInverted := tfRGB8;
  2955. fglInternalFormat := GL_RGB8;
  2956. end;
  2957. constructor TfdBGR10.Create;
  2958. begin
  2959. inherited Create;
  2960. fFormat := tfBGR10;
  2961. fWithAlpha := tfBGR10A2;
  2962. fWithoutAlpha := tfBGR10;
  2963. fRGBInverted := tfRGB10;
  2964. fRange.r := $3FF;
  2965. fRange.g := $3FF;
  2966. fRange.b := $3FF;
  2967. fRange.a := $000;
  2968. fShift.r := 20;
  2969. fShift.g := 10;
  2970. fShift.b := 0;
  2971. fShift.a := 0;
  2972. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2973. fglInternalFormat := GL_RGB10;
  2974. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2975. end;
  2976. constructor TfdBGR12.Create;
  2977. begin
  2978. inherited Create;
  2979. fFormat := tfBGR12;
  2980. fWithAlpha := tfBGRA12;
  2981. fWithoutAlpha := tfBGR12;
  2982. fRGBInverted := tfRGB12;
  2983. fglInternalFormat := GL_RGB12;
  2984. end;
  2985. constructor TfdBGR16.Create;
  2986. begin
  2987. inherited Create;
  2988. fFormat := tfBGR16;
  2989. fWithAlpha := tfBGRA16;
  2990. fWithoutAlpha := tfBGR16;
  2991. fRGBInverted := tfRGB16;
  2992. fglInternalFormat := GL_RGB16;
  2993. end;
  2994. constructor TfdBGRA2.Create;
  2995. begin
  2996. inherited Create;
  2997. fFormat := tfBGRA2;
  2998. fWithAlpha := tfBGRA4;
  2999. fWithoutAlpha := tfBGR4;
  3000. fRGBInverted := tfRGBA2;
  3001. fglInternalFormat := GL_RGBA2;
  3002. end;
  3003. constructor TfdBGRA4.Create;
  3004. begin
  3005. inherited Create;
  3006. fFormat := tfBGRA4;
  3007. fWithAlpha := tfBGRA4;
  3008. fWithoutAlpha := tfBGR4;
  3009. fRGBInverted := tfRGBA4;
  3010. fRange.r := $F;
  3011. fRange.g := $F;
  3012. fRange.b := $F;
  3013. fRange.a := $F;
  3014. fShift.r := 8;
  3015. fShift.g := 4;
  3016. fShift.b := 0;
  3017. fShift.a := 12;
  3018. fglFormat := GL_BGRA;
  3019. fglInternalFormat := GL_RGBA4;
  3020. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3021. end;
  3022. constructor TfdBGR5A1.Create;
  3023. begin
  3024. inherited Create;
  3025. fFormat := tfBGR5A1;
  3026. fWithAlpha := tfBGR5A1;
  3027. fWithoutAlpha := tfBGR5;
  3028. fRGBInverted := tfRGB5A1;
  3029. fRange.r := $1F;
  3030. fRange.g := $1F;
  3031. fRange.b := $1F;
  3032. fRange.a := $01;
  3033. fShift.r := 10;
  3034. fShift.g := 5;
  3035. fShift.b := 0;
  3036. fShift.a := 15;
  3037. fglFormat := GL_BGRA;
  3038. fglInternalFormat := GL_RGB5_A1;
  3039. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3040. end;
  3041. constructor TfdBGRA8.Create;
  3042. begin
  3043. inherited Create;
  3044. fFormat := tfBGRA8;
  3045. fWithAlpha := tfBGRA8;
  3046. fWithoutAlpha := tfBGR8;
  3047. fRGBInverted := tfRGBA8;
  3048. fglInternalFormat := GL_RGBA8;
  3049. end;
  3050. constructor TfdBGR10A2.Create;
  3051. begin
  3052. inherited Create;
  3053. fFormat := tfBGR10A2;
  3054. fWithAlpha := tfBGR10A2;
  3055. fWithoutAlpha := tfBGR10;
  3056. fRGBInverted := tfRGB10A2;
  3057. fRange.r := $3FF;
  3058. fRange.g := $3FF;
  3059. fRange.b := $3FF;
  3060. fRange.a := $003;
  3061. fShift.r := 20;
  3062. fShift.g := 10;
  3063. fShift.b := 0;
  3064. fShift.a := 30;
  3065. fglFormat := GL_BGRA;
  3066. fglInternalFormat := GL_RGB10_A2;
  3067. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3068. end;
  3069. constructor TfdBGRA12.Create;
  3070. begin
  3071. inherited Create;
  3072. fFormat := tfBGRA12;
  3073. fWithAlpha := tfBGRA12;
  3074. fWithoutAlpha := tfBGR12;
  3075. fRGBInverted := tfRGBA12;
  3076. fglInternalFormat := GL_RGBA12;
  3077. end;
  3078. constructor TfdBGRA16.Create;
  3079. begin
  3080. inherited Create;
  3081. fFormat := tfBGRA16;
  3082. fWithAlpha := tfBGRA16;
  3083. fWithoutAlpha := tfBGR16;
  3084. fRGBInverted := tfRGBA16;
  3085. fglInternalFormat := GL_RGBA16;
  3086. end;
  3087. constructor TfdDepth16.Create;
  3088. begin
  3089. inherited Create;
  3090. fFormat := tfDepth16;
  3091. fWithAlpha := tfEmpty;
  3092. fWithoutAlpha := tfDepth16;
  3093. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3094. end;
  3095. constructor TfdDepth24.Create;
  3096. begin
  3097. inherited Create;
  3098. fFormat := tfDepth24;
  3099. fWithAlpha := tfEmpty;
  3100. fWithoutAlpha := tfDepth24;
  3101. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3102. end;
  3103. constructor TfdDepth32.Create;
  3104. begin
  3105. inherited Create;
  3106. fFormat := tfDepth32;
  3107. fWithAlpha := tfEmpty;
  3108. fWithoutAlpha := tfDepth32;
  3109. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3110. end;
  3111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3112. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3113. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3114. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3115. begin
  3116. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3117. end;
  3118. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3119. begin
  3120. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3121. end;
  3122. constructor TfdS3tcDtx1RGBA.Create;
  3123. begin
  3124. inherited Create;
  3125. fFormat := tfS3tcDtx1RGBA;
  3126. fWithAlpha := tfS3tcDtx1RGBA;
  3127. fUncompressed := tfRGB5A1;
  3128. fPixelSize := 0.5;
  3129. fIsCompressed := true;
  3130. fglFormat := GL_COMPRESSED_RGBA;
  3131. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3132. fglDataFormat := GL_UNSIGNED_BYTE;
  3133. end;
  3134. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3135. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3136. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3137. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3138. begin
  3139. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3140. end;
  3141. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3142. begin
  3143. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3144. end;
  3145. constructor TfdS3tcDtx3RGBA.Create;
  3146. begin
  3147. inherited Create;
  3148. fFormat := tfS3tcDtx3RGBA;
  3149. fWithAlpha := tfS3tcDtx3RGBA;
  3150. fUncompressed := tfRGBA8;
  3151. fPixelSize := 1.0;
  3152. fIsCompressed := true;
  3153. fglFormat := GL_COMPRESSED_RGBA;
  3154. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3155. fglDataFormat := GL_UNSIGNED_BYTE;
  3156. end;
  3157. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3158. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3159. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3160. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3161. begin
  3162. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3163. end;
  3164. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3165. begin
  3166. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3167. end;
  3168. constructor TfdS3tcDtx5RGBA.Create;
  3169. begin
  3170. inherited Create;
  3171. fFormat := tfS3tcDtx3RGBA;
  3172. fWithAlpha := tfS3tcDtx3RGBA;
  3173. fUncompressed := tfRGBA8;
  3174. fPixelSize := 1.0;
  3175. fIsCompressed := true;
  3176. fglFormat := GL_COMPRESSED_RGBA;
  3177. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3178. fglDataFormat := GL_UNSIGNED_BYTE;
  3179. end;
  3180. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3181. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3182. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3183. class procedure TFormatDescriptor.Init;
  3184. begin
  3185. if not Assigned(FormatDescriptorCS) then
  3186. FormatDescriptorCS := TCriticalSection.Create;
  3187. end;
  3188. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3189. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3190. begin
  3191. FormatDescriptorCS.Enter;
  3192. try
  3193. result := FormatDescriptors[aFormat];
  3194. if not Assigned(result) then begin
  3195. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3196. FormatDescriptors[aFormat] := result;
  3197. end;
  3198. finally
  3199. FormatDescriptorCS.Leave;
  3200. end;
  3201. end;
  3202. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3203. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3204. begin
  3205. result := Get(Get(aFormat).WithAlpha);
  3206. end;
  3207. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3208. class procedure TFormatDescriptor.Clear;
  3209. var
  3210. f: TglBitmapFormat;
  3211. begin
  3212. FormatDescriptorCS.Enter;
  3213. try
  3214. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3215. FreeAndNil(FormatDescriptors[f]);
  3216. finally
  3217. FormatDescriptorCS.Leave;
  3218. end;
  3219. end;
  3220. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3221. class procedure TFormatDescriptor.Finalize;
  3222. begin
  3223. Clear;
  3224. FreeAndNil(FormatDescriptorCS);
  3225. end;
  3226. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3227. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3229. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3230. begin
  3231. Update(aValue, fRange.r, fShift.r);
  3232. end;
  3233. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3234. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3235. begin
  3236. Update(aValue, fRange.g, fShift.g);
  3237. end;
  3238. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3239. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3240. begin
  3241. Update(aValue, fRange.b, fShift.b);
  3242. end;
  3243. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3244. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3245. begin
  3246. Update(aValue, fRange.a, fShift.a);
  3247. end;
  3248. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3249. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3250. aShift: Byte);
  3251. begin
  3252. aShift := 0;
  3253. aRange := 0;
  3254. if (aMask = 0) then
  3255. exit;
  3256. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3257. inc(aShift);
  3258. aMask := aMask shr 1;
  3259. end;
  3260. aRange := 1;
  3261. while (aMask > 0) do begin
  3262. aRange := aRange shl 1;
  3263. aMask := aMask shr 1;
  3264. end;
  3265. dec(aRange);
  3266. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3267. end;
  3268. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3269. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3270. var
  3271. data: QWord;
  3272. s: Integer;
  3273. begin
  3274. data :=
  3275. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3276. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3277. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3278. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3279. s := Round(fPixelSize);
  3280. case s of
  3281. 1: aData^ := data;
  3282. 2: PWord(aData)^ := data;
  3283. 4: PCardinal(aData)^ := data;
  3284. 8: PQWord(aData)^ := data;
  3285. else
  3286. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3287. end;
  3288. inc(aData, s);
  3289. end;
  3290. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3291. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3292. var
  3293. data: QWord;
  3294. s, i: Integer;
  3295. begin
  3296. s := Round(fPixelSize);
  3297. case s of
  3298. 1: data := aData^;
  3299. 2: data := PWord(aData)^;
  3300. 4: data := PCardinal(aData)^;
  3301. 8: data := PQWord(aData)^;
  3302. else
  3303. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3304. end;
  3305. for i := 0 to 3 do
  3306. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3307. inc(aData, s);
  3308. end;
  3309. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3310. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3311. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3312. procedure TbmpColorTableFormat.CreateColorTable;
  3313. var
  3314. i: Integer;
  3315. begin
  3316. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3317. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3318. if (Format = tfLuminance4) then
  3319. SetLength(fColorTable, 16)
  3320. else
  3321. SetLength(fColorTable, 256);
  3322. case Format of
  3323. tfLuminance4: begin
  3324. for i := 0 to High(fColorTable) do begin
  3325. fColorTable[i].r := 16 * i;
  3326. fColorTable[i].g := 16 * i;
  3327. fColorTable[i].b := 16 * i;
  3328. fColorTable[i].a := 0;
  3329. end;
  3330. end;
  3331. tfLuminance8: begin
  3332. for i := 0 to High(fColorTable) do begin
  3333. fColorTable[i].r := i;
  3334. fColorTable[i].g := i;
  3335. fColorTable[i].b := i;
  3336. fColorTable[i].a := 0;
  3337. end;
  3338. end;
  3339. tfR3G3B2: begin
  3340. for i := 0 to High(fColorTable) do begin
  3341. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3342. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3343. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3344. fColorTable[i].a := 0;
  3345. end;
  3346. end;
  3347. end;
  3348. end;
  3349. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3350. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3351. var
  3352. d: Byte;
  3353. begin
  3354. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3355. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3356. case Format of
  3357. tfLuminance4: begin
  3358. if (aMapData = nil) then
  3359. aData^ := 0;
  3360. d := LuminanceWeight(aPixel) and Range.r;
  3361. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3362. inc(PByte(aMapData), 4);
  3363. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3364. inc(aData);
  3365. aMapData := nil;
  3366. end;
  3367. end;
  3368. tfLuminance8: begin
  3369. aData^ := LuminanceWeight(aPixel) and Range.r;
  3370. inc(aData);
  3371. end;
  3372. tfR3G3B2: begin
  3373. aData^ := Round(
  3374. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3375. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3376. ((aPixel.Data.b and Range.b) shl Shift.b));
  3377. inc(aData);
  3378. end;
  3379. end;
  3380. end;
  3381. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3382. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3383. var
  3384. idx: QWord;
  3385. s: Integer;
  3386. bits: Byte;
  3387. f: Single;
  3388. begin
  3389. s := Trunc(fPixelSize);
  3390. f := fPixelSize - s;
  3391. bits := Round(8 * f);
  3392. case s of
  3393. 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
  3394. 1: idx := aData^;
  3395. 2: idx := PWord(aData)^;
  3396. 4: idx := PCardinal(aData)^;
  3397. 8: idx := PQWord(aData)^;
  3398. else
  3399. raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3400. end;
  3401. if (idx >= Length(fColorTable)) then
  3402. raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
  3403. with fColorTable[idx] do begin
  3404. aPixel.Data.r := r;
  3405. aPixel.Data.g := g;
  3406. aPixel.Data.b := b;
  3407. aPixel.Data.a := a;
  3408. end;
  3409. inc(PByte(aMapData), bits);
  3410. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3411. inc(aData, 1);
  3412. dec(PByte(aMapData), 8);
  3413. end;
  3414. inc(aData, s);
  3415. end;
  3416. destructor TbmpColorTableFormat.Destroy;
  3417. begin
  3418. SetLength(fColorTable, 0);
  3419. inherited Destroy;
  3420. end;
  3421. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3422. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3423. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3424. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3425. var
  3426. i: Integer;
  3427. begin
  3428. for i := 0 to 3 do begin
  3429. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3430. if (aSourceFD.Range.arr[i] > 0) then
  3431. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3432. else
  3433. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3434. end;
  3435. end;
  3436. end;
  3437. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3438. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3439. begin
  3440. with aFuncRec do begin
  3441. if (Source.Range.r > 0) then
  3442. Dest.Data.r := Source.Data.r;
  3443. if (Source.Range.g > 0) then
  3444. Dest.Data.g := Source.Data.g;
  3445. if (Source.Range.b > 0) then
  3446. Dest.Data.b := Source.Data.b;
  3447. if (Source.Range.a > 0) then
  3448. Dest.Data.a := Source.Data.a;
  3449. end;
  3450. end;
  3451. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3452. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3453. var
  3454. i: Integer;
  3455. begin
  3456. with aFuncRec do begin
  3457. for i := 0 to 3 do
  3458. if (Source.Range.arr[i] > 0) then
  3459. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3460. end;
  3461. end;
  3462. type
  3463. TShiftData = packed record
  3464. case Integer of
  3465. 0: (r, g, b, a: SmallInt);
  3466. 1: (arr: array[0..3] of SmallInt);
  3467. end;
  3468. PShiftData = ^TShiftData;
  3469. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3470. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3471. var
  3472. i: Integer;
  3473. begin
  3474. with aFuncRec do
  3475. for i := 0 to 3 do
  3476. if (Source.Range.arr[i] > 0) then
  3477. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3478. end;
  3479. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3480. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3481. begin
  3482. with aFuncRec do begin
  3483. Dest.Data := Source.Data;
  3484. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3485. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3486. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3487. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3488. end;
  3489. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3490. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3491. end;
  3492. end;
  3493. end;
  3494. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3495. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3496. var
  3497. i: Integer;
  3498. begin
  3499. with aFuncRec do begin
  3500. for i := 0 to 3 do
  3501. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3502. end;
  3503. end;
  3504. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3505. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3506. var
  3507. Temp: Single;
  3508. begin
  3509. with FuncRec do begin
  3510. if (FuncRec.Args = nil) then begin //source has no alpha
  3511. Temp :=
  3512. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3513. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3514. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3515. Dest.Data.a := Round(Dest.Range.a * Temp);
  3516. end else
  3517. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3518. end;
  3519. end;
  3520. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3521. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3522. type
  3523. PglBitmapPixelData = ^TglBitmapPixelData;
  3524. begin
  3525. with FuncRec do begin
  3526. Dest.Data.r := Source.Data.r;
  3527. Dest.Data.g := Source.Data.g;
  3528. Dest.Data.b := Source.Data.b;
  3529. with PglBitmapPixelData(Args)^ do
  3530. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3531. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3532. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3533. Dest.Data.a := 0
  3534. else
  3535. Dest.Data.a := Dest.Range.a;
  3536. end;
  3537. end;
  3538. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3539. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3540. begin
  3541. with FuncRec do begin
  3542. Dest.Data.r := Source.Data.r;
  3543. Dest.Data.g := Source.Data.g;
  3544. Dest.Data.b := Source.Data.b;
  3545. Dest.Data.a := PCardinal(Args)^;
  3546. end;
  3547. end;
  3548. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3549. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3550. type
  3551. PRGBPix = ^TRGBPix;
  3552. TRGBPix = array [0..2] of byte;
  3553. var
  3554. Temp: Byte;
  3555. begin
  3556. while aWidth > 0 do begin
  3557. Temp := PRGBPix(aData)^[0];
  3558. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3559. PRGBPix(aData)^[2] := Temp;
  3560. if aHasAlpha then
  3561. Inc(aData, 4)
  3562. else
  3563. Inc(aData, 3);
  3564. dec(aWidth);
  3565. end;
  3566. end;
  3567. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3568. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3569. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3570. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  3571. begin
  3572. result := TFormatDescriptor.Get(Format);
  3573. end;
  3574. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3575. function TglBitmap.GetWidth: Integer;
  3576. begin
  3577. if (ffX in fDimension.Fields) then
  3578. result := fDimension.X
  3579. else
  3580. result := -1;
  3581. end;
  3582. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3583. function TglBitmap.GetHeight: Integer;
  3584. begin
  3585. if (ffY in fDimension.Fields) then
  3586. result := fDimension.Y
  3587. else
  3588. result := -1;
  3589. end;
  3590. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3591. function TglBitmap.GetFileWidth: Integer;
  3592. begin
  3593. result := Max(1, Width);
  3594. end;
  3595. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3596. function TglBitmap.GetFileHeight: Integer;
  3597. begin
  3598. result := Max(1, Height);
  3599. end;
  3600. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3601. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3602. begin
  3603. if fCustomData = aValue then
  3604. exit;
  3605. fCustomData := aValue;
  3606. end;
  3607. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3608. procedure TglBitmap.SetCustomName(const aValue: String);
  3609. begin
  3610. if fCustomName = aValue then
  3611. exit;
  3612. fCustomName := aValue;
  3613. end;
  3614. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3615. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3616. begin
  3617. if fCustomNameW = aValue then
  3618. exit;
  3619. fCustomNameW := aValue;
  3620. end;
  3621. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3622. procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
  3623. begin
  3624. if fFreeDataOnDestroy = aValue then
  3625. exit;
  3626. fFreeDataOnDestroy := aValue;
  3627. end;
  3628. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3629. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3630. begin
  3631. if fDeleteTextureOnFree = aValue then
  3632. exit;
  3633. fDeleteTextureOnFree := aValue;
  3634. end;
  3635. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3636. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3637. begin
  3638. if fFormat = aValue then
  3639. exit;
  3640. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3641. raise EglBitmapUnsupportedFormat.Create(Format);
  3642. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  3643. end;
  3644. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3645. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3646. begin
  3647. if fFreeDataAfterGenTexture = aValue then
  3648. exit;
  3649. fFreeDataAfterGenTexture := aValue;
  3650. end;
  3651. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3652. procedure TglBitmap.SetID(const aValue: Cardinal);
  3653. begin
  3654. if fID = aValue then
  3655. exit;
  3656. fID := aValue;
  3657. end;
  3658. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3659. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3660. begin
  3661. if fMipMap = aValue then
  3662. exit;
  3663. fMipMap := aValue;
  3664. end;
  3665. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3666. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3667. begin
  3668. if fTarget = aValue then
  3669. exit;
  3670. fTarget := aValue;
  3671. end;
  3672. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3673. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3674. var
  3675. MaxAnisotropic: Integer;
  3676. begin
  3677. fAnisotropic := aValue;
  3678. if (ID > 0) then begin
  3679. if GL_EXT_texture_filter_anisotropic then begin
  3680. if fAnisotropic > 0 then begin
  3681. Bind(false);
  3682. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3683. if aValue > MaxAnisotropic then
  3684. fAnisotropic := MaxAnisotropic;
  3685. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3686. end;
  3687. end else begin
  3688. fAnisotropic := 0;
  3689. end;
  3690. end;
  3691. end;
  3692. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3693. procedure TglBitmap.CreateID;
  3694. begin
  3695. if (ID <> 0) then
  3696. glDeleteTextures(1, @fID);
  3697. glGenTextures(1, @fID);
  3698. Bind(false);
  3699. end;
  3700. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3701. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3702. begin
  3703. // Set Up Parameters
  3704. SetWrap(fWrapS, fWrapT, fWrapR);
  3705. SetFilter(fFilterMin, fFilterMag);
  3706. SetAnisotropic(fAnisotropic);
  3707. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3708. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  3709. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3710. // Mip Maps Generation Mode
  3711. aBuildWithGlu := false;
  3712. if (MipMap = mmMipmap) then begin
  3713. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3714. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3715. else
  3716. aBuildWithGlu := true;
  3717. end else if (MipMap = mmMipmapGlu) then
  3718. aBuildWithGlu := true;
  3719. end;
  3720. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3721. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  3722. const aWidth: Integer; const aHeight: Integer);
  3723. var
  3724. s: Single;
  3725. begin
  3726. if (Data <> aData) then begin
  3727. if (Assigned(Data)) then
  3728. FreeMem(Data);
  3729. fData := aData;
  3730. end;
  3731. if not Assigned(fData) then begin
  3732. fPixelSize := 0;
  3733. fRowSize := 0;
  3734. end else begin
  3735. FillChar(fDimension, SizeOf(fDimension), 0);
  3736. if aWidth <> -1 then begin
  3737. fDimension.Fields := fDimension.Fields + [ffX];
  3738. fDimension.X := aWidth;
  3739. end;
  3740. if aHeight <> -1 then begin
  3741. fDimension.Fields := fDimension.Fields + [ffY];
  3742. fDimension.Y := aHeight;
  3743. end;
  3744. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3745. fFormat := aFormat;
  3746. fPixelSize := Ceil(s);
  3747. fRowSize := Ceil(s * aWidth);
  3748. end;
  3749. end;
  3750. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3751. function TglBitmap.FlipHorz: Boolean;
  3752. begin
  3753. result := false;
  3754. end;
  3755. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3756. function TglBitmap.FlipVert: Boolean;
  3757. begin
  3758. result := false;
  3759. end;
  3760. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3761. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3762. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3763. procedure TglBitmap.AfterConstruction;
  3764. begin
  3765. inherited AfterConstruction;
  3766. fID := 0;
  3767. fTarget := 0;
  3768. fIsResident := false;
  3769. fMipMap := glBitmapDefaultMipmap;
  3770. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3771. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3772. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3773. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3774. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3775. end;
  3776. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3777. procedure TglBitmap.BeforeDestruction;
  3778. var
  3779. NewData: PByte;
  3780. begin
  3781. if fFreeDataOnDestroy then begin
  3782. NewData := nil;
  3783. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  3784. end;
  3785. if (fID > 0) and fDeleteTextureOnFree then
  3786. glDeleteTextures(1, @fID);
  3787. inherited BeforeDestruction;
  3788. end;
  3789. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3790. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  3791. var
  3792. TempPos: Integer;
  3793. begin
  3794. if not Assigned(aResType) then begin
  3795. TempPos := Pos('.', aResource);
  3796. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3797. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3798. end;
  3799. end;
  3800. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3801. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3802. var
  3803. fs: TFileStream;
  3804. begin
  3805. if not FileExists(aFilename) then
  3806. raise EglBitmap.Create('file does not exist: ' + aFilename);
  3807. fFilename := aFilename;
  3808. fs := TFileStream.Create(fFilename, fmOpenRead);
  3809. try
  3810. fs.Position := 0;
  3811. LoadFromStream(fs);
  3812. finally
  3813. fs.Free;
  3814. end;
  3815. end;
  3816. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3817. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3818. begin
  3819. {$IFDEF GLB_SUPPORT_PNG_READ}
  3820. if not LoadPNG(aStream) then
  3821. {$ENDIF}
  3822. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3823. if not LoadJPEG(aStream) then
  3824. {$ENDIF}
  3825. if not LoadDDS(aStream) then
  3826. if not LoadTGA(aStream) then
  3827. if not LoadBMP(aStream) then
  3828. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3829. end;
  3830. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3831. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3832. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3833. var
  3834. tmpData: PByte;
  3835. size: Integer;
  3836. begin
  3837. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3838. GetMem(tmpData, size);
  3839. try
  3840. FillChar(tmpData^, size, #$FF);
  3841. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  3842. except
  3843. if Assigned(tmpData) then
  3844. FreeMem(tmpData);
  3845. raise;
  3846. end;
  3847. AddFunc(Self, aFunc, false, aFormat, aArgs);
  3848. end;
  3849. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3850. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  3851. var
  3852. rs: TResourceStream;
  3853. begin
  3854. PrepareResType(aResource, aResType);
  3855. rs := TResourceStream.Create(aInstance, aResource, aResType);
  3856. try
  3857. LoadFromStream(rs);
  3858. finally
  3859. rs.Free;
  3860. end;
  3861. end;
  3862. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3863. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3864. var
  3865. rs: TResourceStream;
  3866. begin
  3867. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  3868. try
  3869. LoadFromStream(rs);
  3870. finally
  3871. rs.Free;
  3872. end;
  3873. end;
  3874. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3875. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3876. var
  3877. fs: TFileStream;
  3878. begin
  3879. fs := TFileStream.Create(aFileName, fmCreate);
  3880. try
  3881. fs.Position := 0;
  3882. SaveToStream(fs, aFileType);
  3883. finally
  3884. fs.Free;
  3885. end;
  3886. end;
  3887. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3888. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3889. begin
  3890. case aFileType of
  3891. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3892. ftPNG: SavePNG(aStream);
  3893. {$ENDIF}
  3894. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3895. ftJPEG: SaveJPEG(aStream);
  3896. {$ENDIF}
  3897. ftDDS: SaveDDS(aStream);
  3898. ftTGA: SaveTGA(aStream);
  3899. ftBMP: SaveBMP(aStream);
  3900. end;
  3901. end;
  3902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3903. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3904. begin
  3905. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3906. end;
  3907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3908. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3909. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3910. var
  3911. DestData, TmpData, SourceData: pByte;
  3912. TempHeight, TempWidth: Integer;
  3913. SourceFD, DestFD: TFormatDescriptor;
  3914. SourceMD, DestMD: Pointer;
  3915. FuncRec: TglBitmapFunctionRec;
  3916. begin
  3917. Assert(Assigned(Data));
  3918. Assert(Assigned(aSource));
  3919. Assert(Assigned(aSource.Data));
  3920. result := false;
  3921. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3922. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3923. DestFD := TFormatDescriptor.Get(aFormat);
  3924. if (SourceFD.IsCompressed) then
  3925. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  3926. if (DestFD.IsCompressed) then
  3927. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  3928. // inkompatible Formats so CreateTemp
  3929. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3930. aCreateTemp := true;
  3931. // Values
  3932. TempHeight := Max(1, aSource.Height);
  3933. TempWidth := Max(1, aSource.Width);
  3934. FuncRec.Sender := Self;
  3935. FuncRec.Args := aArgs;
  3936. TmpData := nil;
  3937. if aCreateTemp then begin
  3938. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  3939. DestData := TmpData;
  3940. end else
  3941. DestData := Data;
  3942. try
  3943. SourceFD.PreparePixel(FuncRec.Source);
  3944. DestFD.PreparePixel (FuncRec.Dest);
  3945. SourceMD := SourceFD.CreateMappingData;
  3946. DestMD := DestFD.CreateMappingData;
  3947. FuncRec.Size := aSource.Dimension;
  3948. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3949. try
  3950. SourceData := aSource.Data;
  3951. FuncRec.Position.Y := 0;
  3952. while FuncRec.Position.Y < TempHeight do begin
  3953. FuncRec.Position.X := 0;
  3954. while FuncRec.Position.X < TempWidth do begin
  3955. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3956. aFunc(FuncRec);
  3957. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3958. inc(FuncRec.Position.X);
  3959. end;
  3960. inc(FuncRec.Position.Y);
  3961. end;
  3962. // Updating Image or InternalFormat
  3963. if aCreateTemp then
  3964. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  3965. else if (aFormat <> fFormat) then
  3966. Format := aFormat;
  3967. result := true;
  3968. finally
  3969. SourceFD.FreeMappingData(SourceMD);
  3970. DestFD.FreeMappingData(DestMD);
  3971. end;
  3972. except
  3973. if aCreateTemp and Assigned(TmpData) then
  3974. FreeMem(TmpData);
  3975. raise;
  3976. end;
  3977. end;
  3978. end;
  3979. {$IFDEF GLB_SDL}
  3980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3981. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  3982. var
  3983. Row, RowSize: Integer;
  3984. SourceData, TmpData: PByte;
  3985. TempDepth: Integer;
  3986. FormatDesc: TFormatDescriptor;
  3987. function GetRowPointer(Row: Integer): pByte;
  3988. begin
  3989. result := aSurface.pixels;
  3990. Inc(result, Row * RowSize);
  3991. end;
  3992. begin
  3993. result := false;
  3994. FormatDesc := TFormatDescriptor.Get(Format);
  3995. if FormatDesc.IsCompressed then
  3996. raise EglBitmapUnsupportedFormat.Create(Format);
  3997. if Assigned(Data) then begin
  3998. case Trunc(FormatDesc.PixelSize) of
  3999. 1: TempDepth := 8;
  4000. 2: TempDepth := 16;
  4001. 3: TempDepth := 24;
  4002. 4: TempDepth := 32;
  4003. else
  4004. raise EglBitmapUnsupportedFormat.Create(Format);
  4005. end;
  4006. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4007. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4008. SourceData := Data;
  4009. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4010. for Row := 0 to FileHeight-1 do begin
  4011. TmpData := GetRowPointer(Row);
  4012. if Assigned(TmpData) then begin
  4013. Move(SourceData^, TmpData^, RowSize);
  4014. inc(SourceData, RowSize);
  4015. end;
  4016. end;
  4017. result := true;
  4018. end;
  4019. end;
  4020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4021. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4022. var
  4023. pSource, pData, pTempData: PByte;
  4024. Row, RowSize, TempWidth, TempHeight: Integer;
  4025. IntFormat: TglBitmapFormat;
  4026. FormatDesc: TFormatDescriptor;
  4027. function GetRowPointer(Row: Integer): pByte;
  4028. begin
  4029. result := aSurface^.pixels;
  4030. Inc(result, Row * RowSize);
  4031. end;
  4032. begin
  4033. result := false;
  4034. if (Assigned(aSurface)) then begin
  4035. with aSurface^.format^ do begin
  4036. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  4037. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4038. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  4039. break;
  4040. end;
  4041. if (IntFormat = tfEmpty) then
  4042. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  4043. end;
  4044. TempWidth := aSurface^.w;
  4045. TempHeight := aSurface^.h;
  4046. RowSize := FormatDesc.GetSize(TempWidth, 1);
  4047. GetMem(pData, TempHeight * RowSize);
  4048. try
  4049. pTempData := pData;
  4050. for Row := 0 to TempHeight -1 do begin
  4051. pSource := GetRowPointer(Row);
  4052. if (Assigned(pSource)) then begin
  4053. Move(pSource^, pTempData^, RowSize);
  4054. Inc(pTempData, RowSize);
  4055. end;
  4056. end;
  4057. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4058. result := true;
  4059. except
  4060. if Assigned(pData) then
  4061. FreeMem(pData);
  4062. raise;
  4063. end;
  4064. end;
  4065. end;
  4066. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4067. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4068. var
  4069. Row, Col, AlphaInterleave: Integer;
  4070. pSource, pDest: PByte;
  4071. function GetRowPointer(Row: Integer): pByte;
  4072. begin
  4073. result := aSurface.pixels;
  4074. Inc(result, Row * Width);
  4075. end;
  4076. begin
  4077. result := false;
  4078. if Assigned(Data) then begin
  4079. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  4080. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4081. AlphaInterleave := 0;
  4082. case Format of
  4083. tfLuminance8Alpha8:
  4084. AlphaInterleave := 1;
  4085. tfBGRA8, tfRGBA8:
  4086. AlphaInterleave := 3;
  4087. end;
  4088. pSource := Data;
  4089. for Row := 0 to Height -1 do begin
  4090. pDest := GetRowPointer(Row);
  4091. if Assigned(pDest) then begin
  4092. for Col := 0 to Width -1 do begin
  4093. Inc(pSource, AlphaInterleave);
  4094. pDest^ := pSource^;
  4095. Inc(pDest);
  4096. Inc(pSource);
  4097. end;
  4098. end;
  4099. end;
  4100. result := true;
  4101. end;
  4102. end;
  4103. end;
  4104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4105. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4106. var
  4107. bmp: TglBitmap2D;
  4108. begin
  4109. bmp := TglBitmap2D.Create;
  4110. try
  4111. bmp.AssignFromSurface(aSurface);
  4112. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4113. finally
  4114. bmp.Free;
  4115. end;
  4116. end;
  4117. {$ENDIF}
  4118. {$IFDEF GLB_DELPHI}
  4119. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4120. function CreateGrayPalette: HPALETTE;
  4121. var
  4122. Idx: Integer;
  4123. Pal: PLogPalette;
  4124. begin
  4125. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4126. Pal.palVersion := $300;
  4127. Pal.palNumEntries := 256;
  4128. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4129. Pal.palPalEntry[Idx].peRed := Idx;
  4130. Pal.palPalEntry[Idx].peGreen := Idx;
  4131. Pal.palPalEntry[Idx].peBlue := Idx;
  4132. Pal.palPalEntry[Idx].peFlags := 0;
  4133. end;
  4134. Result := CreatePalette(Pal^);
  4135. FreeMem(Pal);
  4136. end;
  4137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4138. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4139. var
  4140. Row: Integer;
  4141. pSource, pData: PByte;
  4142. begin
  4143. result := false;
  4144. if Assigned(Data) then begin
  4145. if Assigned(aBitmap) then begin
  4146. aBitmap.Width := Width;
  4147. aBitmap.Height := Height;
  4148. case Format of
  4149. tfAlpha8, tfLuminance8: begin
  4150. aBitmap.PixelFormat := pf8bit;
  4151. aBitmap.Palette := CreateGrayPalette;
  4152. end;
  4153. tfRGB5A1:
  4154. aBitmap.PixelFormat := pf15bit;
  4155. tfR5G6B5:
  4156. aBitmap.PixelFormat := pf16bit;
  4157. tfRGB8, tfBGR8:
  4158. aBitmap.PixelFormat := pf24bit;
  4159. tfRGBA8, tfBGRA8:
  4160. aBitmap.PixelFormat := pf32bit;
  4161. else
  4162. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4163. end;
  4164. pSource := Data;
  4165. for Row := 0 to FileHeight -1 do begin
  4166. pData := aBitmap.Scanline[Row];
  4167. Move(pSource^, pData^, fRowSize);
  4168. Inc(pSource, fRowSize);
  4169. if (Format in [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A)
  4170. SwapRGB(pData, FileWidth, Format = tfRGBA8);
  4171. end;
  4172. result := true;
  4173. end;
  4174. end;
  4175. end;
  4176. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4177. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4178. var
  4179. pSource, pData, pTempData: PByte;
  4180. Row, RowSize, TempWidth, TempHeight: Integer;
  4181. IntFormat: TglBitmapFormat;
  4182. begin
  4183. result := false;
  4184. if (Assigned(aBitmap)) then begin
  4185. case aBitmap.PixelFormat of
  4186. pf8bit:
  4187. IntFormat := tfLuminance8;
  4188. pf15bit:
  4189. IntFormat := tfRGB5A1;
  4190. pf16bit:
  4191. IntFormat := tfR5G6B5;
  4192. pf24bit:
  4193. IntFormat := tfBGR8;
  4194. pf32bit:
  4195. IntFormat := tfBGRA8;
  4196. else
  4197. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4198. end;
  4199. TempWidth := aBitmap.Width;
  4200. TempHeight := aBitmap.Height;
  4201. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4202. GetMem(pData, TempHeight * RowSize);
  4203. try
  4204. pTempData := pData;
  4205. for Row := 0 to TempHeight -1 do begin
  4206. pSource := aBitmap.Scanline[Row];
  4207. if (Assigned(pSource)) then begin
  4208. Move(pSource^, pTempData^, RowSize);
  4209. Inc(pTempData, RowSize);
  4210. end;
  4211. end;
  4212. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4213. result := true;
  4214. except
  4215. if Assigned(pData) then
  4216. FreeMem(pData);
  4217. raise;
  4218. end;
  4219. end;
  4220. end;
  4221. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4222. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4223. var
  4224. Row, Col, AlphaInterleave: Integer;
  4225. pSource, pDest: PByte;
  4226. begin
  4227. result := false;
  4228. if Assigned(Data) then begin
  4229. if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
  4230. if Assigned(aBitmap) then begin
  4231. aBitmap.PixelFormat := pf8bit;
  4232. aBitmap.Palette := CreateGrayPalette;
  4233. aBitmap.Width := Width;
  4234. aBitmap.Height := Height;
  4235. case Format of
  4236. tfLuminance8Alpha8:
  4237. AlphaInterleave := 1;
  4238. tfRGBA8, tfBGRA8:
  4239. AlphaInterleave := 3;
  4240. else
  4241. AlphaInterleave := 0;
  4242. end;
  4243. // Copy Data
  4244. pSource := Data;
  4245. for Row := 0 to Height -1 do begin
  4246. pDest := aBitmap.Scanline[Row];
  4247. if Assigned(pDest) then begin
  4248. for Col := 0 to Width -1 do begin
  4249. Inc(pSource, AlphaInterleave);
  4250. pDest^ := pSource^;
  4251. Inc(pDest);
  4252. Inc(pSource);
  4253. end;
  4254. end;
  4255. end;
  4256. result := true;
  4257. end;
  4258. end;
  4259. end;
  4260. end;
  4261. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4262. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4263. var
  4264. tex: TglBitmap2D;
  4265. begin
  4266. tex := TglBitmap2D.Create;
  4267. try
  4268. tex.AssignFromBitmap(ABitmap);
  4269. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4270. finally
  4271. tex.Free;
  4272. end;
  4273. end;
  4274. {$ENDIF}
  4275. {$IFDEF GLB_LAZARUS}
  4276. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4277. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4278. var
  4279. rid: TRawImageDescription;
  4280. FormatDesc: TFormatDescriptor;
  4281. begin
  4282. result := false;
  4283. if not Assigned(aImage) or (Format = tfEmpty) then
  4284. exit;
  4285. FormatDesc := TFormatDescriptor.Get(Format);
  4286. if FormatDesc.IsCompressed then
  4287. exit;
  4288. FillChar(rid{%H-}, SizeOf(rid), 0);
  4289. if (Format in [
  4290. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  4291. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  4292. tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
  4293. rid.Format := ricfGray
  4294. else
  4295. rid.Format := ricfRGBA;
  4296. rid.Width := Width;
  4297. rid.Height := Height;
  4298. rid.Depth := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
  4299. rid.BitOrder := riboBitsInOrder;
  4300. rid.ByteOrder := riboLSBFirst;
  4301. rid.LineOrder := riloTopToBottom;
  4302. rid.LineEnd := rileTight;
  4303. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4304. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4305. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4306. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4307. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4308. rid.RedShift := FormatDesc.Shift.r;
  4309. rid.GreenShift := FormatDesc.Shift.g;
  4310. rid.BlueShift := FormatDesc.Shift.b;
  4311. rid.AlphaShift := FormatDesc.Shift.a;
  4312. rid.MaskBitsPerPixel := 0;
  4313. rid.PaletteColorCount := 0;
  4314. aImage.DataDescription := rid;
  4315. aImage.CreateData;
  4316. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4317. result := true;
  4318. end;
  4319. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4320. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4321. var
  4322. f: TglBitmapFormat;
  4323. FormatDesc: TFormatDescriptor;
  4324. ImageData: PByte;
  4325. ImageSize: Integer;
  4326. CanCopy: Boolean;
  4327. procedure CopyConvert;
  4328. var
  4329. bfFormat: TbmpBitfieldFormat;
  4330. pSourceLine, pDestLine: PByte;
  4331. pSourceMD, pDestMD: Pointer;
  4332. x, y: Integer;
  4333. pixel: TglBitmapPixelData;
  4334. begin
  4335. bfFormat := TbmpBitfieldFormat.Create;
  4336. with aImage.DataDescription do begin
  4337. bfFormat.RedMask := ((1 shl RedPrec) - 1) shl RedShift;
  4338. bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
  4339. bfFormat.BlueMask := ((1 shl BluePrec) - 1) shl BlueShift;
  4340. bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
  4341. bfFormat.PixelSize := BitsPerPixel / 8;
  4342. end;
  4343. pSourceMD := bfFormat.CreateMappingData;
  4344. pDestMD := FormatDesc.CreateMappingData;
  4345. try
  4346. for y := 0 to aImage.Height-1 do begin
  4347. pSourceLine := aImage.PixelData + y * aImage.DataDescription.BytesPerLine;
  4348. pDestLine := ImageData + y * Round(FormatDesc.PixelSize * aImage.Width);
  4349. for x := 0 to aImage.Width-1 do begin
  4350. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  4351. FormatDesc.Map(pixel, pDestLine, pDestMD);
  4352. end;
  4353. end;
  4354. finally
  4355. FormatDesc.FreeMappingData(pDestMD);
  4356. bfFormat.FreeMappingData(pSourceMD);
  4357. bfFormat.Free;
  4358. end;
  4359. end;
  4360. begin
  4361. result := false;
  4362. if not Assigned(aImage) then
  4363. exit;
  4364. for f := High(f) downto Low(f) do begin
  4365. FormatDesc := TFormatDescriptor.Get(f);
  4366. with aImage.DataDescription do
  4367. if FormatDesc.MaskMatch(
  4368. (QWord(1 shl RedPrec )-1) shl RedShift,
  4369. (QWord(1 shl GreenPrec)-1) shl GreenShift,
  4370. (QWord(1 shl BluePrec )-1) shl BlueShift,
  4371. (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
  4372. break;
  4373. end;
  4374. if (f = tfEmpty) then
  4375. exit;
  4376. CanCopy :=
  4377. (Round(FormatDesc.PixelSize * 8) = aImage.DataDescription.Depth) and
  4378. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  4379. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4380. ImageData := GetMem(ImageSize);
  4381. try
  4382. if CanCopy then
  4383. Move(aImage.PixelData^, ImageData^, ImageSize)
  4384. else
  4385. CopyConvert;
  4386. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4387. except
  4388. if Assigned(ImageData) then
  4389. FreeMem(ImageData);
  4390. raise;
  4391. end;
  4392. result := true;
  4393. end;
  4394. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4395. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4396. var
  4397. rid: TRawImageDescription;
  4398. FormatDesc: TFormatDescriptor;
  4399. Pixel: TglBitmapPixelData;
  4400. x, y: Integer;
  4401. srcMD: Pointer;
  4402. src, dst: PByte;
  4403. begin
  4404. result := false;
  4405. if not Assigned(aImage) or (Format = tfEmpty) then
  4406. exit;
  4407. FormatDesc := TFormatDescriptor.Get(Format);
  4408. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4409. exit;
  4410. FillChar(rid{%H-}, SizeOf(rid), 0);
  4411. rid.Format := ricfGray;
  4412. rid.Width := Width;
  4413. rid.Height := Height;
  4414. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4415. rid.BitOrder := riboBitsInOrder;
  4416. rid.ByteOrder := riboLSBFirst;
  4417. rid.LineOrder := riloTopToBottom;
  4418. rid.LineEnd := rileTight;
  4419. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4420. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4421. rid.GreenPrec := 0;
  4422. rid.BluePrec := 0;
  4423. rid.AlphaPrec := 0;
  4424. rid.RedShift := 0;
  4425. rid.GreenShift := 0;
  4426. rid.BlueShift := 0;
  4427. rid.AlphaShift := 0;
  4428. rid.MaskBitsPerPixel := 0;
  4429. rid.PaletteColorCount := 0;
  4430. aImage.DataDescription := rid;
  4431. aImage.CreateData;
  4432. srcMD := FormatDesc.CreateMappingData;
  4433. try
  4434. FormatDesc.PreparePixel(Pixel);
  4435. src := Data;
  4436. dst := aImage.PixelData;
  4437. for y := 0 to Height-1 do
  4438. for x := 0 to Width-1 do begin
  4439. FormatDesc.Unmap(src, Pixel, srcMD);
  4440. case rid.BitsPerPixel of
  4441. 8: begin
  4442. dst^ := Pixel.Data.a;
  4443. inc(dst);
  4444. end;
  4445. 16: begin
  4446. PWord(dst)^ := Pixel.Data.a;
  4447. inc(dst, 2);
  4448. end;
  4449. 24: begin
  4450. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4451. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4452. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4453. inc(dst, 3);
  4454. end;
  4455. 32: begin
  4456. PCardinal(dst)^ := Pixel.Data.a;
  4457. inc(dst, 4);
  4458. end;
  4459. else
  4460. raise EglBitmapUnsupportedFormat.Create(Format);
  4461. end;
  4462. end;
  4463. finally
  4464. FormatDesc.FreeMappingData(srcMD);
  4465. end;
  4466. result := true;
  4467. end;
  4468. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4469. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4470. var
  4471. tex: TglBitmap2D;
  4472. begin
  4473. tex := TglBitmap2D.Create;
  4474. try
  4475. tex.AssignFromLazIntfImage(aImage);
  4476. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4477. finally
  4478. tex.Free;
  4479. end;
  4480. end;
  4481. {$ENDIF}
  4482. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4483. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4484. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4485. var
  4486. rs: TResourceStream;
  4487. begin
  4488. PrepareResType(aResource, aResType);
  4489. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4490. try
  4491. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4492. finally
  4493. rs.Free;
  4494. end;
  4495. end;
  4496. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4497. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4498. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4499. var
  4500. rs: TResourceStream;
  4501. begin
  4502. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4503. try
  4504. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4505. finally
  4506. rs.Free;
  4507. end;
  4508. end;
  4509. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4510. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4511. begin
  4512. if TFormatDescriptor.Get(Format).IsCompressed then
  4513. raise EglBitmapUnsupportedFormat.Create(Format);
  4514. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4515. end;
  4516. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4517. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4518. var
  4519. FS: TFileStream;
  4520. begin
  4521. FS := TFileStream.Create(aFileName, fmOpenRead);
  4522. try
  4523. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4524. finally
  4525. FS.Free;
  4526. end;
  4527. end;
  4528. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4529. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4530. var
  4531. tex: TglBitmap2D;
  4532. begin
  4533. tex := TglBitmap2D.Create(aStream);
  4534. try
  4535. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4536. finally
  4537. tex.Free;
  4538. end;
  4539. end;
  4540. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4541. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4542. var
  4543. DestData, DestData2, SourceData: pByte;
  4544. TempHeight, TempWidth: Integer;
  4545. SourceFD, DestFD: TFormatDescriptor;
  4546. SourceMD, DestMD, DestMD2: Pointer;
  4547. FuncRec: TglBitmapFunctionRec;
  4548. begin
  4549. result := false;
  4550. Assert(Assigned(Data));
  4551. Assert(Assigned(aBitmap));
  4552. Assert(Assigned(aBitmap.Data));
  4553. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4554. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4555. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4556. DestFD := TFormatDescriptor.Get(Format);
  4557. if not Assigned(aFunc) then begin
  4558. aFunc := glBitmapAlphaFunc;
  4559. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4560. end else
  4561. FuncRec.Args := aArgs;
  4562. // Values
  4563. TempHeight := aBitmap.FileHeight;
  4564. TempWidth := aBitmap.FileWidth;
  4565. FuncRec.Sender := Self;
  4566. FuncRec.Size := Dimension;
  4567. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4568. DestData := Data;
  4569. DestData2 := Data;
  4570. SourceData := aBitmap.Data;
  4571. // Mapping
  4572. SourceFD.PreparePixel(FuncRec.Source);
  4573. DestFD.PreparePixel (FuncRec.Dest);
  4574. SourceMD := SourceFD.CreateMappingData;
  4575. DestMD := DestFD.CreateMappingData;
  4576. DestMD2 := DestFD.CreateMappingData;
  4577. try
  4578. FuncRec.Position.Y := 0;
  4579. while FuncRec.Position.Y < TempHeight do begin
  4580. FuncRec.Position.X := 0;
  4581. while FuncRec.Position.X < TempWidth do begin
  4582. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4583. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4584. aFunc(FuncRec);
  4585. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4586. inc(FuncRec.Position.X);
  4587. end;
  4588. inc(FuncRec.Position.Y);
  4589. end;
  4590. finally
  4591. SourceFD.FreeMappingData(SourceMD);
  4592. DestFD.FreeMappingData(DestMD);
  4593. DestFD.FreeMappingData(DestMD2);
  4594. end;
  4595. end;
  4596. end;
  4597. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4598. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4599. begin
  4600. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4601. end;
  4602. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4603. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4604. var
  4605. PixelData: TglBitmapPixelData;
  4606. begin
  4607. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4608. result := AddAlphaFromColorKeyFloat(
  4609. aRed / PixelData.Range.r,
  4610. aGreen / PixelData.Range.g,
  4611. aBlue / PixelData.Range.b,
  4612. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4613. end;
  4614. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4615. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4616. var
  4617. values: array[0..2] of Single;
  4618. tmp: Cardinal;
  4619. i: Integer;
  4620. PixelData: TglBitmapPixelData;
  4621. begin
  4622. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4623. with PixelData do begin
  4624. values[0] := aRed;
  4625. values[1] := aGreen;
  4626. values[2] := aBlue;
  4627. for i := 0 to 2 do begin
  4628. tmp := Trunc(Range.arr[i] * aDeviation);
  4629. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4630. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4631. end;
  4632. Data.a := 0;
  4633. Range.a := 0;
  4634. end;
  4635. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4636. end;
  4637. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4638. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4639. begin
  4640. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4641. end;
  4642. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4643. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4644. var
  4645. PixelData: TglBitmapPixelData;
  4646. begin
  4647. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4648. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4649. end;
  4650. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4651. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4652. var
  4653. PixelData: TglBitmapPixelData;
  4654. begin
  4655. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4656. with PixelData do
  4657. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4658. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4659. end;
  4660. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4661. function TglBitmap.RemoveAlpha: Boolean;
  4662. var
  4663. FormatDesc: TFormatDescriptor;
  4664. begin
  4665. result := false;
  4666. FormatDesc := TFormatDescriptor.Get(Format);
  4667. if Assigned(Data) then begin
  4668. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4669. raise EglBitmapUnsupportedFormat.Create(Format);
  4670. result := ConvertTo(FormatDesc.WithoutAlpha);
  4671. end;
  4672. end;
  4673. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4674. function TglBitmap.Clone: TglBitmap;
  4675. var
  4676. Temp: TglBitmap;
  4677. TempPtr: PByte;
  4678. Size: Integer;
  4679. begin
  4680. result := nil;
  4681. Temp := (ClassType.Create as TglBitmap);
  4682. try
  4683. // copy texture data if assigned
  4684. if Assigned(Data) then begin
  4685. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4686. GetMem(TempPtr, Size);
  4687. try
  4688. Move(Data^, TempPtr^, Size);
  4689. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4690. except
  4691. if Assigned(TempPtr) then
  4692. FreeMem(TempPtr);
  4693. raise;
  4694. end;
  4695. end else begin
  4696. TempPtr := nil;
  4697. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4698. end;
  4699. // copy properties
  4700. Temp.fID := ID;
  4701. Temp.fTarget := Target;
  4702. Temp.fFormat := Format;
  4703. Temp.fMipMap := MipMap;
  4704. Temp.fAnisotropic := Anisotropic;
  4705. Temp.fBorderColor := fBorderColor;
  4706. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4707. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4708. Temp.fFilterMin := fFilterMin;
  4709. Temp.fFilterMag := fFilterMag;
  4710. Temp.fWrapS := fWrapS;
  4711. Temp.fWrapT := fWrapT;
  4712. Temp.fWrapR := fWrapR;
  4713. Temp.fFilename := fFilename;
  4714. Temp.fCustomName := fCustomName;
  4715. Temp.fCustomNameW := fCustomNameW;
  4716. Temp.fCustomData := fCustomData;
  4717. result := Temp;
  4718. except
  4719. FreeAndNil(Temp);
  4720. raise;
  4721. end;
  4722. end;
  4723. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4724. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4725. var
  4726. SourceFD, DestFD: TFormatDescriptor;
  4727. SourcePD, DestPD: TglBitmapPixelData;
  4728. ShiftData: TShiftData;
  4729. function CanCopyDirect: Boolean;
  4730. begin
  4731. result :=
  4732. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4733. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4734. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4735. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4736. end;
  4737. function CanShift: Boolean;
  4738. begin
  4739. result :=
  4740. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4741. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4742. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4743. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4744. end;
  4745. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4746. begin
  4747. result := 0;
  4748. while (aSource > aDest) and (aSource > 0) do begin
  4749. inc(result);
  4750. aSource := aSource shr 1;
  4751. end;
  4752. end;
  4753. begin
  4754. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4755. SourceFD := TFormatDescriptor.Get(Format);
  4756. DestFD := TFormatDescriptor.Get(aFormat);
  4757. SourceFD.PreparePixel(SourcePD);
  4758. DestFD.PreparePixel (DestPD);
  4759. if CanCopyDirect then
  4760. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4761. else if CanShift then begin
  4762. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4763. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4764. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4765. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4766. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4767. end else
  4768. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4769. end else
  4770. result := true;
  4771. end;
  4772. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4773. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4774. begin
  4775. if aUseRGB or aUseAlpha then
  4776. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4777. ((Byte(aUseAlpha) and 1) shl 1) or
  4778. (Byte(aUseRGB) and 1) ));
  4779. end;
  4780. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4781. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4782. begin
  4783. fBorderColor[0] := aRed;
  4784. fBorderColor[1] := aGreen;
  4785. fBorderColor[2] := aBlue;
  4786. fBorderColor[3] := aAlpha;
  4787. if (ID > 0) then begin
  4788. Bind(false);
  4789. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4790. end;
  4791. end;
  4792. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4793. procedure TglBitmap.FreeData;
  4794. var
  4795. TempPtr: PByte;
  4796. begin
  4797. TempPtr := nil;
  4798. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  4799. end;
  4800. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4801. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4802. const aAlpha: Byte);
  4803. begin
  4804. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4805. end;
  4806. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4807. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4808. var
  4809. PixelData: TglBitmapPixelData;
  4810. begin
  4811. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4812. FillWithColorFloat(
  4813. aRed / PixelData.Range.r,
  4814. aGreen / PixelData.Range.g,
  4815. aBlue / PixelData.Range.b,
  4816. aAlpha / PixelData.Range.a);
  4817. end;
  4818. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4819. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4820. var
  4821. PixelData: TglBitmapPixelData;
  4822. begin
  4823. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4824. with PixelData do begin
  4825. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4826. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4827. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4828. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4829. end;
  4830. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4831. end;
  4832. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4833. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  4834. begin
  4835. //check MIN filter
  4836. case aMin of
  4837. GL_NEAREST:
  4838. fFilterMin := GL_NEAREST;
  4839. GL_LINEAR:
  4840. fFilterMin := GL_LINEAR;
  4841. GL_NEAREST_MIPMAP_NEAREST:
  4842. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4843. GL_LINEAR_MIPMAP_NEAREST:
  4844. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4845. GL_NEAREST_MIPMAP_LINEAR:
  4846. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4847. GL_LINEAR_MIPMAP_LINEAR:
  4848. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4849. else
  4850. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  4851. end;
  4852. //check MAG filter
  4853. case aMag of
  4854. GL_NEAREST:
  4855. fFilterMag := GL_NEAREST;
  4856. GL_LINEAR:
  4857. fFilterMag := GL_LINEAR;
  4858. else
  4859. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  4860. end;
  4861. //apply filter
  4862. if (ID > 0) then begin
  4863. Bind(false);
  4864. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4865. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4866. case fFilterMin of
  4867. GL_NEAREST, GL_LINEAR:
  4868. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4869. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4870. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4871. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4872. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4873. end;
  4874. end else
  4875. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4876. end;
  4877. end;
  4878. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4879. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  4880. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4881. begin
  4882. case aValue of
  4883. GL_CLAMP:
  4884. aTarget := GL_CLAMP;
  4885. GL_REPEAT:
  4886. aTarget := GL_REPEAT;
  4887. GL_CLAMP_TO_EDGE: begin
  4888. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4889. aTarget := GL_CLAMP_TO_EDGE
  4890. else
  4891. aTarget := GL_CLAMP;
  4892. end;
  4893. GL_CLAMP_TO_BORDER: begin
  4894. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4895. aTarget := GL_CLAMP_TO_BORDER
  4896. else
  4897. aTarget := GL_CLAMP;
  4898. end;
  4899. GL_MIRRORED_REPEAT: begin
  4900. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4901. aTarget := GL_MIRRORED_REPEAT
  4902. else
  4903. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4904. end;
  4905. else
  4906. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  4907. end;
  4908. end;
  4909. begin
  4910. CheckAndSetWrap(S, fWrapS);
  4911. CheckAndSetWrap(T, fWrapT);
  4912. CheckAndSetWrap(R, fWrapR);
  4913. if (ID > 0) then begin
  4914. Bind(false);
  4915. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4916. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4917. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4918. end;
  4919. end;
  4920. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4921. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  4922. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  4923. begin
  4924. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  4925. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  4926. fSwizzle[aIndex] := aValue
  4927. else
  4928. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  4929. end;
  4930. begin
  4931. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4932. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  4933. CheckAndSetValue(r, 0);
  4934. CheckAndSetValue(g, 1);
  4935. CheckAndSetValue(b, 2);
  4936. CheckAndSetValue(a, 3);
  4937. if (ID > 0) then begin
  4938. Bind(false);
  4939. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
  4940. end;
  4941. end;
  4942. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4943. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4944. begin
  4945. if aEnableTextureUnit then
  4946. glEnable(Target);
  4947. if (ID > 0) then
  4948. glBindTexture(Target, ID);
  4949. end;
  4950. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4951. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4952. begin
  4953. if aDisableTextureUnit then
  4954. glDisable(Target);
  4955. glBindTexture(Target, 0);
  4956. end;
  4957. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4958. constructor TglBitmap.Create;
  4959. begin
  4960. if (ClassType = TglBitmap) then
  4961. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4962. {$IFDEF GLB_NATIVE_OGL}
  4963. glbReadOpenGLExtensions;
  4964. {$ENDIF}
  4965. inherited Create;
  4966. fFormat := glBitmapGetDefaultFormat;
  4967. fFreeDataOnDestroy := true;
  4968. end;
  4969. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4970. constructor TglBitmap.Create(const aFileName: String);
  4971. begin
  4972. Create;
  4973. LoadFromFile(aFileName);
  4974. end;
  4975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4976. constructor TglBitmap.Create(const aStream: TStream);
  4977. begin
  4978. Create;
  4979. LoadFromStream(aStream);
  4980. end;
  4981. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4982. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
  4983. var
  4984. ImageSize: Integer;
  4985. begin
  4986. Create;
  4987. if not Assigned(aData) then begin
  4988. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4989. GetMem(aData, ImageSize);
  4990. try
  4991. FillChar(aData^, ImageSize, #$FF);
  4992. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4993. except
  4994. if Assigned(aData) then
  4995. FreeMem(aData);
  4996. raise;
  4997. end;
  4998. end else begin
  4999. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5000. fFreeDataOnDestroy := false;
  5001. end;
  5002. end;
  5003. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5004. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5005. begin
  5006. Create;
  5007. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  5008. end;
  5009. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5010. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  5011. begin
  5012. Create;
  5013. LoadFromResource(aInstance, aResource, aResType);
  5014. end;
  5015. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5016. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5017. begin
  5018. Create;
  5019. LoadFromResourceID(aInstance, aResourceID, aResType);
  5020. end;
  5021. {$IFDEF GLB_SUPPORT_PNG_READ}
  5022. {$IF DEFINED(GLB_LAZ_PNG)}
  5023. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5024. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5025. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5026. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5027. const
  5028. MAGIC_LEN = 8;
  5029. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  5030. var
  5031. png: TPortableNetworkGraphic;
  5032. intf: TLazIntfImage;
  5033. StreamPos: Int64;
  5034. magic: String[MAGIC_LEN];
  5035. begin
  5036. result := true;
  5037. StreamPos := aStream.Position;
  5038. SetLength(magic, MAGIC_LEN);
  5039. aStream.Read(magic[1], MAGIC_LEN);
  5040. aStream.Position := StreamPos;
  5041. if (magic <> PNG_MAGIC) then begin
  5042. result := false;
  5043. exit;
  5044. end;
  5045. png := TPortableNetworkGraphic.Create;
  5046. try try
  5047. png.LoadFromStream(aStream);
  5048. intf := png.CreateIntfImage;
  5049. try try
  5050. AssignFromLazIntfImage(intf);
  5051. except
  5052. result := false;
  5053. aStream.Position := StreamPos;
  5054. exit;
  5055. end;
  5056. finally
  5057. intf.Free;
  5058. end;
  5059. except
  5060. result := false;
  5061. aStream.Position := StreamPos;
  5062. exit;
  5063. end;
  5064. finally
  5065. png.Free;
  5066. end;
  5067. end;
  5068. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5069. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5070. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5071. var
  5072. Surface: PSDL_Surface;
  5073. RWops: PSDL_RWops;
  5074. begin
  5075. result := false;
  5076. RWops := glBitmapCreateRWops(aStream);
  5077. try
  5078. if IMG_isPNG(RWops) > 0 then begin
  5079. Surface := IMG_LoadPNG_RW(RWops);
  5080. try
  5081. AssignFromSurface(Surface);
  5082. result := true;
  5083. finally
  5084. SDL_FreeSurface(Surface);
  5085. end;
  5086. end;
  5087. finally
  5088. SDL_FreeRW(RWops);
  5089. end;
  5090. end;
  5091. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5093. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5094. begin
  5095. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5096. end;
  5097. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5098. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5099. var
  5100. StreamPos: Int64;
  5101. signature: array [0..7] of byte;
  5102. png: png_structp;
  5103. png_info: png_infop;
  5104. TempHeight, TempWidth: Integer;
  5105. Format: TglBitmapFormat;
  5106. png_data: pByte;
  5107. png_rows: array of pByte;
  5108. Row, LineSize: Integer;
  5109. begin
  5110. result := false;
  5111. if not init_libPNG then
  5112. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5113. try
  5114. // signature
  5115. StreamPos := aStream.Position;
  5116. aStream.Read(signature{%H-}, 8);
  5117. aStream.Position := StreamPos;
  5118. if png_check_sig(@signature, 8) <> 0 then begin
  5119. // png read struct
  5120. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5121. if png = nil then
  5122. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5123. // png info
  5124. png_info := png_create_info_struct(png);
  5125. if png_info = nil then begin
  5126. png_destroy_read_struct(@png, nil, nil);
  5127. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5128. end;
  5129. // set read callback
  5130. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5131. // read informations
  5132. png_read_info(png, png_info);
  5133. // size
  5134. TempHeight := png_get_image_height(png, png_info);
  5135. TempWidth := png_get_image_width(png, png_info);
  5136. // format
  5137. case png_get_color_type(png, png_info) of
  5138. PNG_COLOR_TYPE_GRAY:
  5139. Format := tfLuminance8;
  5140. PNG_COLOR_TYPE_GRAY_ALPHA:
  5141. Format := tfLuminance8Alpha8;
  5142. PNG_COLOR_TYPE_RGB:
  5143. Format := tfRGB8;
  5144. PNG_COLOR_TYPE_RGB_ALPHA:
  5145. Format := tfRGBA8;
  5146. else
  5147. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5148. end;
  5149. // cut upper 8 bit from 16 bit formats
  5150. if png_get_bit_depth(png, png_info) > 8 then
  5151. png_set_strip_16(png);
  5152. // expand bitdepth smaller than 8
  5153. if png_get_bit_depth(png, png_info) < 8 then
  5154. png_set_expand(png);
  5155. // allocating mem for scanlines
  5156. LineSize := png_get_rowbytes(png, png_info);
  5157. GetMem(png_data, TempHeight * LineSize);
  5158. try
  5159. SetLength(png_rows, TempHeight);
  5160. for Row := Low(png_rows) to High(png_rows) do begin
  5161. png_rows[Row] := png_data;
  5162. Inc(png_rows[Row], Row * LineSize);
  5163. end;
  5164. // read complete image into scanlines
  5165. png_read_image(png, @png_rows[0]);
  5166. // read end
  5167. png_read_end(png, png_info);
  5168. // destroy read struct
  5169. png_destroy_read_struct(@png, @png_info, nil);
  5170. SetLength(png_rows, 0);
  5171. // set new data
  5172. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5173. result := true;
  5174. except
  5175. if Assigned(png_data) then
  5176. FreeMem(png_data);
  5177. raise;
  5178. end;
  5179. end;
  5180. finally
  5181. quit_libPNG;
  5182. end;
  5183. end;
  5184. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5186. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5187. var
  5188. StreamPos: Int64;
  5189. Png: TPNGObject;
  5190. Header: String[8];
  5191. Row, Col, PixSize, LineSize: Integer;
  5192. NewImage, pSource, pDest, pAlpha: pByte;
  5193. PngFormat: TglBitmapFormat;
  5194. FormatDesc: TFormatDescriptor;
  5195. const
  5196. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5197. begin
  5198. result := false;
  5199. StreamPos := aStream.Position;
  5200. aStream.Read(Header[0], SizeOf(Header));
  5201. aStream.Position := StreamPos;
  5202. {Test if the header matches}
  5203. if Header = PngHeader then begin
  5204. Png := TPNGObject.Create;
  5205. try
  5206. Png.LoadFromStream(aStream);
  5207. case Png.Header.ColorType of
  5208. COLOR_GRAYSCALE:
  5209. PngFormat := tfLuminance8;
  5210. COLOR_GRAYSCALEALPHA:
  5211. PngFormat := tfLuminance8Alpha8;
  5212. COLOR_RGB:
  5213. PngFormat := tfBGR8;
  5214. COLOR_RGBALPHA:
  5215. PngFormat := tfBGRA8;
  5216. else
  5217. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5218. end;
  5219. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5220. PixSize := Round(FormatDesc.PixelSize);
  5221. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5222. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5223. try
  5224. pDest := NewImage;
  5225. case Png.Header.ColorType of
  5226. COLOR_RGB, COLOR_GRAYSCALE:
  5227. begin
  5228. for Row := 0 to Png.Height -1 do begin
  5229. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5230. Inc(pDest, LineSize);
  5231. end;
  5232. end;
  5233. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5234. begin
  5235. PixSize := PixSize -1;
  5236. for Row := 0 to Png.Height -1 do begin
  5237. pSource := Png.Scanline[Row];
  5238. pAlpha := pByte(Png.AlphaScanline[Row]);
  5239. for Col := 0 to Png.Width -1 do begin
  5240. Move (pSource^, pDest^, PixSize);
  5241. Inc(pSource, PixSize);
  5242. Inc(pDest, PixSize);
  5243. pDest^ := pAlpha^;
  5244. inc(pAlpha);
  5245. Inc(pDest);
  5246. end;
  5247. end;
  5248. end;
  5249. else
  5250. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5251. end;
  5252. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5253. result := true;
  5254. except
  5255. if Assigned(NewImage) then
  5256. FreeMem(NewImage);
  5257. raise;
  5258. end;
  5259. finally
  5260. Png.Free;
  5261. end;
  5262. end;
  5263. end;
  5264. {$IFEND}
  5265. {$ENDIF}
  5266. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5267. {$IFDEF GLB_LIB_PNG}
  5268. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5269. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5270. begin
  5271. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5272. end;
  5273. {$ENDIF}
  5274. {$IF DEFINED(GLB_LAZ_PNG)}
  5275. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5276. procedure TglBitmap.SavePNG(const aStream: TStream);
  5277. var
  5278. png: TPortableNetworkGraphic;
  5279. intf: TLazIntfImage;
  5280. raw: TRawImage;
  5281. begin
  5282. png := TPortableNetworkGraphic.Create;
  5283. intf := TLazIntfImage.Create(0, 0);
  5284. try
  5285. if not AssignToLazIntfImage(intf) then
  5286. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5287. intf.GetRawImage(raw);
  5288. png.LoadFromRawImage(raw, false);
  5289. png.SaveToStream(aStream);
  5290. finally
  5291. png.Free;
  5292. intf.Free;
  5293. end;
  5294. end;
  5295. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5296. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5297. procedure TglBitmap.SavePNG(const aStream: TStream);
  5298. var
  5299. png: png_structp;
  5300. png_info: png_infop;
  5301. png_rows: array of pByte;
  5302. LineSize: Integer;
  5303. ColorType: Integer;
  5304. Row: Integer;
  5305. FormatDesc: TFormatDescriptor;
  5306. begin
  5307. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5308. raise EglBitmapUnsupportedFormat.Create(Format);
  5309. if not init_libPNG then
  5310. raise Exception.Create('unable to initialize libPNG.');
  5311. try
  5312. case Format of
  5313. tfAlpha8, tfLuminance8:
  5314. ColorType := PNG_COLOR_TYPE_GRAY;
  5315. tfLuminance8Alpha8:
  5316. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5317. tfBGR8, tfRGB8:
  5318. ColorType := PNG_COLOR_TYPE_RGB;
  5319. tfBGRA8, tfRGBA8:
  5320. ColorType := PNG_COLOR_TYPE_RGBA;
  5321. else
  5322. raise EglBitmapUnsupportedFormat.Create(Format);
  5323. end;
  5324. FormatDesc := TFormatDescriptor.Get(Format);
  5325. LineSize := FormatDesc.GetSize(Width, 1);
  5326. // creating array for scanline
  5327. SetLength(png_rows, Height);
  5328. try
  5329. for Row := 0 to Height - 1 do begin
  5330. png_rows[Row] := Data;
  5331. Inc(png_rows[Row], Row * LineSize)
  5332. end;
  5333. // write struct
  5334. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5335. if png = nil then
  5336. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5337. // create png info
  5338. png_info := png_create_info_struct(png);
  5339. if png_info = nil then begin
  5340. png_destroy_write_struct(@png, nil);
  5341. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5342. end;
  5343. // set read callback
  5344. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5345. // set compression
  5346. png_set_compression_level(png, 6);
  5347. if Format in [tfBGR8, tfBGRA8] then
  5348. png_set_bgr(png);
  5349. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5350. png_write_info(png, png_info);
  5351. png_write_image(png, @png_rows[0]);
  5352. png_write_end(png, png_info);
  5353. png_destroy_write_struct(@png, @png_info);
  5354. finally
  5355. SetLength(png_rows, 0);
  5356. end;
  5357. finally
  5358. quit_libPNG;
  5359. end;
  5360. end;
  5361. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5362. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5363. procedure TglBitmap.SavePNG(const aStream: TStream);
  5364. var
  5365. Png: TPNGObject;
  5366. pSource, pDest: pByte;
  5367. X, Y, PixSize: Integer;
  5368. ColorType: Cardinal;
  5369. Alpha: Boolean;
  5370. pTemp: pByte;
  5371. Temp: Byte;
  5372. begin
  5373. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5374. raise EglBitmapUnsupportedFormat.Create(Format);
  5375. case Format of
  5376. tfAlpha8, tfLuminance8: begin
  5377. ColorType := COLOR_GRAYSCALE;
  5378. PixSize := 1;
  5379. Alpha := false;
  5380. end;
  5381. tfLuminance8Alpha8: begin
  5382. ColorType := COLOR_GRAYSCALEALPHA;
  5383. PixSize := 1;
  5384. Alpha := true;
  5385. end;
  5386. tfBGR8, tfRGB8: begin
  5387. ColorType := COLOR_RGB;
  5388. PixSize := 3;
  5389. Alpha := false;
  5390. end;
  5391. tfBGRA8, tfRGBA8: begin
  5392. ColorType := COLOR_RGBALPHA;
  5393. PixSize := 3;
  5394. Alpha := true
  5395. end;
  5396. else
  5397. raise EglBitmapUnsupportedFormat.Create(Format);
  5398. end;
  5399. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5400. try
  5401. // Copy ImageData
  5402. pSource := Data;
  5403. for Y := 0 to Height -1 do begin
  5404. pDest := png.ScanLine[Y];
  5405. for X := 0 to Width -1 do begin
  5406. Move(pSource^, pDest^, PixSize);
  5407. Inc(pDest, PixSize);
  5408. Inc(pSource, PixSize);
  5409. if Alpha then begin
  5410. png.AlphaScanline[Y]^[X] := pSource^;
  5411. Inc(pSource);
  5412. end;
  5413. end;
  5414. // convert RGB line to BGR
  5415. if Format in [tfRGB8, tfRGBA8] then begin
  5416. pTemp := png.ScanLine[Y];
  5417. for X := 0 to Width -1 do begin
  5418. Temp := pByteArray(pTemp)^[0];
  5419. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5420. pByteArray(pTemp)^[2] := Temp;
  5421. Inc(pTemp, 3);
  5422. end;
  5423. end;
  5424. end;
  5425. // Save to Stream
  5426. Png.CompressionLevel := 6;
  5427. Png.SaveToStream(aStream);
  5428. finally
  5429. FreeAndNil(Png);
  5430. end;
  5431. end;
  5432. {$IFEND}
  5433. {$ENDIF}
  5434. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5435. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5436. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5437. {$IFDEF GLB_LIB_JPEG}
  5438. type
  5439. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5440. glBitmap_libJPEG_source_mgr = record
  5441. pub: jpeg_source_mgr;
  5442. SrcStream: TStream;
  5443. SrcBuffer: array [1..4096] of byte;
  5444. end;
  5445. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5446. glBitmap_libJPEG_dest_mgr = record
  5447. pub: jpeg_destination_mgr;
  5448. DestStream: TStream;
  5449. DestBuffer: array [1..4096] of byte;
  5450. end;
  5451. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5452. begin
  5453. //DUMMY
  5454. end;
  5455. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5456. begin
  5457. //DUMMY
  5458. end;
  5459. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5460. begin
  5461. //DUMMY
  5462. end;
  5463. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5464. begin
  5465. //DUMMY
  5466. end;
  5467. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5468. begin
  5469. //DUMMY
  5470. end;
  5471. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5472. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5473. var
  5474. src: glBitmap_libJPEG_source_mgr_ptr;
  5475. bytes: integer;
  5476. begin
  5477. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5478. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5479. if (bytes <= 0) then begin
  5480. src^.SrcBuffer[1] := $FF;
  5481. src^.SrcBuffer[2] := JPEG_EOI;
  5482. bytes := 2;
  5483. end;
  5484. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5485. src^.pub.bytes_in_buffer := bytes;
  5486. result := true;
  5487. end;
  5488. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5489. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5490. var
  5491. src: glBitmap_libJPEG_source_mgr_ptr;
  5492. begin
  5493. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5494. if num_bytes > 0 then begin
  5495. // wanted byte isn't in buffer so set stream position and read buffer
  5496. if num_bytes > src^.pub.bytes_in_buffer then begin
  5497. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5498. src^.pub.fill_input_buffer(cinfo);
  5499. end else begin
  5500. // wanted byte is in buffer so only skip
  5501. inc(src^.pub.next_input_byte, num_bytes);
  5502. dec(src^.pub.bytes_in_buffer, num_bytes);
  5503. end;
  5504. end;
  5505. end;
  5506. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5507. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5508. var
  5509. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5510. begin
  5511. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5512. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5513. // write complete buffer
  5514. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5515. // reset buffer
  5516. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5517. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5518. end;
  5519. result := true;
  5520. end;
  5521. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5522. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5523. var
  5524. Idx: Integer;
  5525. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5526. begin
  5527. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5528. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5529. // check for endblock
  5530. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5531. // write endblock
  5532. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5533. // leave
  5534. break;
  5535. end else
  5536. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5537. end;
  5538. end;
  5539. {$ENDIF}
  5540. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5541. {$IF DEFINED(GLB_LAZ_JPEG)}
  5542. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5543. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5544. const
  5545. MAGIC_LEN = 2;
  5546. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  5547. var
  5548. jpeg: TJPEGImage;
  5549. intf: TLazIntfImage;
  5550. StreamPos: Int64;
  5551. magic: String[MAGIC_LEN];
  5552. begin
  5553. result := true;
  5554. StreamPos := aStream.Position;
  5555. SetLength(magic, MAGIC_LEN);
  5556. aStream.Read(magic[1], MAGIC_LEN);
  5557. aStream.Position := StreamPos;
  5558. if (magic <> JPEG_MAGIC) then begin
  5559. result := false;
  5560. exit;
  5561. end;
  5562. jpeg := TJPEGImage.Create;
  5563. try try
  5564. jpeg.LoadFromStream(aStream);
  5565. intf := TLazIntfImage.Create(0, 0);
  5566. try try
  5567. intf.LoadFromBitmap(jpeg.BitmapHandle, jpeg.MaskHandle);
  5568. AssignFromLazIntfImage(intf);
  5569. except
  5570. result := false;
  5571. aStream.Position := StreamPos;
  5572. exit;
  5573. end;
  5574. finally
  5575. intf.Free;
  5576. end;
  5577. except
  5578. result := false;
  5579. aStream.Position := StreamPos;
  5580. exit;
  5581. end;
  5582. finally
  5583. jpeg.Free;
  5584. end;
  5585. end;
  5586. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5587. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5588. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5589. var
  5590. Surface: PSDL_Surface;
  5591. RWops: PSDL_RWops;
  5592. begin
  5593. result := false;
  5594. RWops := glBitmapCreateRWops(aStream);
  5595. try
  5596. if IMG_isJPG(RWops) > 0 then begin
  5597. Surface := IMG_LoadJPG_RW(RWops);
  5598. try
  5599. AssignFromSurface(Surface);
  5600. result := true;
  5601. finally
  5602. SDL_FreeSurface(Surface);
  5603. end;
  5604. end;
  5605. finally
  5606. SDL_FreeRW(RWops);
  5607. end;
  5608. end;
  5609. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5610. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5611. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5612. var
  5613. StreamPos: Int64;
  5614. Temp: array[0..1]of Byte;
  5615. jpeg: jpeg_decompress_struct;
  5616. jpeg_err: jpeg_error_mgr;
  5617. IntFormat: TglBitmapFormat;
  5618. pImage: pByte;
  5619. TempHeight, TempWidth: Integer;
  5620. pTemp: pByte;
  5621. Row: Integer;
  5622. FormatDesc: TFormatDescriptor;
  5623. begin
  5624. result := false;
  5625. if not init_libJPEG then
  5626. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5627. try
  5628. // reading first two bytes to test file and set cursor back to begin
  5629. StreamPos := aStream.Position;
  5630. aStream.Read({%H-}Temp[0], 2);
  5631. aStream.Position := StreamPos;
  5632. // if Bitmap then read file.
  5633. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5634. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5635. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5636. // error managment
  5637. jpeg.err := jpeg_std_error(@jpeg_err);
  5638. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5639. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5640. // decompression struct
  5641. jpeg_create_decompress(@jpeg);
  5642. // allocation space for streaming methods
  5643. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5644. // seeting up custom functions
  5645. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5646. pub.init_source := glBitmap_libJPEG_init_source;
  5647. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5648. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5649. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5650. pub.term_source := glBitmap_libJPEG_term_source;
  5651. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5652. pub.next_input_byte := nil; // until buffer loaded
  5653. SrcStream := aStream;
  5654. end;
  5655. // set global decoding state
  5656. jpeg.global_state := DSTATE_START;
  5657. // read header of jpeg
  5658. jpeg_read_header(@jpeg, false);
  5659. // setting output parameter
  5660. case jpeg.jpeg_color_space of
  5661. JCS_GRAYSCALE:
  5662. begin
  5663. jpeg.out_color_space := JCS_GRAYSCALE;
  5664. IntFormat := tfLuminance8;
  5665. end;
  5666. else
  5667. jpeg.out_color_space := JCS_RGB;
  5668. IntFormat := tfRGB8;
  5669. end;
  5670. // reading image
  5671. jpeg_start_decompress(@jpeg);
  5672. TempHeight := jpeg.output_height;
  5673. TempWidth := jpeg.output_width;
  5674. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5675. // creating new image
  5676. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5677. try
  5678. pTemp := pImage;
  5679. for Row := 0 to TempHeight -1 do begin
  5680. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5681. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5682. end;
  5683. // finish decompression
  5684. jpeg_finish_decompress(@jpeg);
  5685. // destroy decompression
  5686. jpeg_destroy_decompress(@jpeg);
  5687. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5688. result := true;
  5689. except
  5690. if Assigned(pImage) then
  5691. FreeMem(pImage);
  5692. raise;
  5693. end;
  5694. end;
  5695. finally
  5696. quit_libJPEG;
  5697. end;
  5698. end;
  5699. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5700. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5701. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5702. var
  5703. bmp: TBitmap;
  5704. jpg: TJPEGImage;
  5705. StreamPos: Int64;
  5706. Temp: array[0..1]of Byte;
  5707. begin
  5708. result := false;
  5709. // reading first two bytes to test file and set cursor back to begin
  5710. StreamPos := aStream.Position;
  5711. aStream.Read(Temp[0], 2);
  5712. aStream.Position := StreamPos;
  5713. // if Bitmap then read file.
  5714. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5715. bmp := TBitmap.Create;
  5716. try
  5717. jpg := TJPEGImage.Create;
  5718. try
  5719. jpg.LoadFromStream(aStream);
  5720. bmp.Assign(jpg);
  5721. result := AssignFromBitmap(bmp);
  5722. finally
  5723. jpg.Free;
  5724. end;
  5725. finally
  5726. bmp.Free;
  5727. end;
  5728. end;
  5729. end;
  5730. {$IFEND}
  5731. {$ENDIF}
  5732. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5733. {$IF DEFINED(GLB_LAZ_JPEG)}
  5734. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5735. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5736. var
  5737. jpeg: TJPEGImage;
  5738. intf: TLazIntfImage;
  5739. raw: TRawImage;
  5740. begin
  5741. jpeg := TJPEGImage.Create;
  5742. intf := TLazIntfImage.Create(0, 0);
  5743. try
  5744. if not AssignToLazIntfImage(intf) then
  5745. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5746. intf.GetRawImage(raw);
  5747. jpeg.LoadFromRawImage(raw, false);
  5748. jpeg.SaveToStream(aStream);
  5749. finally
  5750. intf.Free;
  5751. jpeg.Free;
  5752. end;
  5753. end;
  5754. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5755. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5756. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5757. var
  5758. jpeg: jpeg_compress_struct;
  5759. jpeg_err: jpeg_error_mgr;
  5760. Row: Integer;
  5761. pTemp, pTemp2: pByte;
  5762. procedure CopyRow(pDest, pSource: pByte);
  5763. var
  5764. X: Integer;
  5765. begin
  5766. for X := 0 to Width - 1 do begin
  5767. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5768. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5769. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5770. Inc(pDest, 3);
  5771. Inc(pSource, 3);
  5772. end;
  5773. end;
  5774. begin
  5775. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5776. raise EglBitmapUnsupportedFormat.Create(Format);
  5777. if not init_libJPEG then
  5778. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5779. try
  5780. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  5781. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5782. // error managment
  5783. jpeg.err := jpeg_std_error(@jpeg_err);
  5784. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5785. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5786. // compression struct
  5787. jpeg_create_compress(@jpeg);
  5788. // allocation space for streaming methods
  5789. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5790. // seeting up custom functions
  5791. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5792. pub.init_destination := glBitmap_libJPEG_init_destination;
  5793. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5794. pub.term_destination := glBitmap_libJPEG_term_destination;
  5795. pub.next_output_byte := @DestBuffer[1];
  5796. pub.free_in_buffer := Length(DestBuffer);
  5797. DestStream := aStream;
  5798. end;
  5799. // very important state
  5800. jpeg.global_state := CSTATE_START;
  5801. jpeg.image_width := Width;
  5802. jpeg.image_height := Height;
  5803. case Format of
  5804. tfAlpha8, tfLuminance8: begin
  5805. jpeg.input_components := 1;
  5806. jpeg.in_color_space := JCS_GRAYSCALE;
  5807. end;
  5808. tfRGB8, tfBGR8: begin
  5809. jpeg.input_components := 3;
  5810. jpeg.in_color_space := JCS_RGB;
  5811. end;
  5812. end;
  5813. jpeg_set_defaults(@jpeg);
  5814. jpeg_set_quality(@jpeg, 95, true);
  5815. jpeg_start_compress(@jpeg, true);
  5816. pTemp := Data;
  5817. if Format = tfBGR8 then
  5818. GetMem(pTemp2, fRowSize)
  5819. else
  5820. pTemp2 := pTemp;
  5821. try
  5822. for Row := 0 to jpeg.image_height -1 do begin
  5823. // prepare row
  5824. if Format = tfBGR8 then
  5825. CopyRow(pTemp2, pTemp)
  5826. else
  5827. pTemp2 := pTemp;
  5828. // write row
  5829. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5830. inc(pTemp, fRowSize);
  5831. end;
  5832. finally
  5833. // free memory
  5834. if Format = tfBGR8 then
  5835. FreeMem(pTemp2);
  5836. end;
  5837. jpeg_finish_compress(@jpeg);
  5838. jpeg_destroy_compress(@jpeg);
  5839. finally
  5840. quit_libJPEG;
  5841. end;
  5842. end;
  5843. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5844. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5845. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5846. var
  5847. Bmp: TBitmap;
  5848. Jpg: TJPEGImage;
  5849. begin
  5850. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5851. raise EglBitmapUnsupportedFormat.Create(Format);
  5852. Bmp := TBitmap.Create;
  5853. try
  5854. Jpg := TJPEGImage.Create;
  5855. try
  5856. AssignToBitmap(Bmp);
  5857. if (Format in [tfAlpha8, tfLuminance8]) then begin
  5858. Jpg.Grayscale := true;
  5859. Jpg.PixelFormat := jf8Bit;
  5860. end;
  5861. Jpg.Assign(Bmp);
  5862. Jpg.SaveToStream(aStream);
  5863. finally
  5864. FreeAndNil(Jpg);
  5865. end;
  5866. finally
  5867. FreeAndNil(Bmp);
  5868. end;
  5869. end;
  5870. {$IFEND}
  5871. {$ENDIF}
  5872. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5873. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5874. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5875. const
  5876. BMP_MAGIC = $4D42;
  5877. BMP_COMP_RGB = 0;
  5878. BMP_COMP_RLE8 = 1;
  5879. BMP_COMP_RLE4 = 2;
  5880. BMP_COMP_BITFIELDS = 3;
  5881. type
  5882. TBMPHeader = packed record
  5883. bfType: Word;
  5884. bfSize: Cardinal;
  5885. bfReserved1: Word;
  5886. bfReserved2: Word;
  5887. bfOffBits: Cardinal;
  5888. end;
  5889. TBMPInfo = packed record
  5890. biSize: Cardinal;
  5891. biWidth: Longint;
  5892. biHeight: Longint;
  5893. biPlanes: Word;
  5894. biBitCount: Word;
  5895. biCompression: Cardinal;
  5896. biSizeImage: Cardinal;
  5897. biXPelsPerMeter: Longint;
  5898. biYPelsPerMeter: Longint;
  5899. biClrUsed: Cardinal;
  5900. biClrImportant: Cardinal;
  5901. end;
  5902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5903. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5904. //////////////////////////////////////////////////////////////////////////////////////////////////
  5905. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5906. begin
  5907. result := tfEmpty;
  5908. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5909. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5910. //Read Compression
  5911. case aInfo.biCompression of
  5912. BMP_COMP_RLE4,
  5913. BMP_COMP_RLE8: begin
  5914. raise EglBitmap.Create('RLE compression is not supported');
  5915. end;
  5916. BMP_COMP_BITFIELDS: begin
  5917. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5918. aStream.Read(aMask.r, SizeOf(aMask.r));
  5919. aStream.Read(aMask.g, SizeOf(aMask.g));
  5920. aStream.Read(aMask.b, SizeOf(aMask.b));
  5921. aStream.Read(aMask.a, SizeOf(aMask.a));
  5922. end else
  5923. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  5924. end;
  5925. end;
  5926. //get suitable format
  5927. case aInfo.biBitCount of
  5928. 8: result := tfLuminance8;
  5929. 16: result := tfBGR5;
  5930. 24: result := tfBGR8;
  5931. 32: result := tfBGRA8;
  5932. end;
  5933. end;
  5934. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5935. var
  5936. i, c: Integer;
  5937. ColorTable: TbmpColorTable;
  5938. begin
  5939. result := nil;
  5940. if (aInfo.biBitCount >= 16) then
  5941. exit;
  5942. aFormat := tfLuminance8;
  5943. c := aInfo.biClrUsed;
  5944. if (c = 0) then
  5945. c := 1 shl aInfo.biBitCount;
  5946. SetLength(ColorTable, c);
  5947. for i := 0 to c-1 do begin
  5948. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5949. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5950. aFormat := tfRGB8;
  5951. end;
  5952. result := TbmpColorTableFormat.Create;
  5953. result.PixelSize := aInfo.biBitCount / 8;
  5954. result.ColorTable := ColorTable;
  5955. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5956. end;
  5957. //////////////////////////////////////////////////////////////////////////////////////////////////
  5958. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5959. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5960. var
  5961. TmpFormat: TglBitmapFormat;
  5962. FormatDesc: TFormatDescriptor;
  5963. begin
  5964. result := nil;
  5965. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5966. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5967. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5968. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5969. aFormat := FormatDesc.Format;
  5970. exit;
  5971. end;
  5972. end;
  5973. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5974. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5975. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5976. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5977. result := TbmpBitfieldFormat.Create;
  5978. result.PixelSize := aInfo.biBitCount / 8;
  5979. result.RedMask := aMask.r;
  5980. result.GreenMask := aMask.g;
  5981. result.BlueMask := aMask.b;
  5982. result.AlphaMask := aMask.a;
  5983. end;
  5984. end;
  5985. var
  5986. //simple types
  5987. StartPos: Int64;
  5988. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5989. PaddingBuff: Cardinal;
  5990. LineBuf, ImageData, TmpData: PByte;
  5991. SourceMD, DestMD: Pointer;
  5992. BmpFormat: TglBitmapFormat;
  5993. //records
  5994. Mask: TglBitmapColorRec;
  5995. Header: TBMPHeader;
  5996. Info: TBMPInfo;
  5997. //classes
  5998. SpecialFormat: TFormatDescriptor;
  5999. FormatDesc: TFormatDescriptor;
  6000. //////////////////////////////////////////////////////////////////////////////////////////////////
  6001. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  6002. var
  6003. i: Integer;
  6004. Pixel: TglBitmapPixelData;
  6005. begin
  6006. aStream.Read(aLineBuf^, rbLineSize);
  6007. SpecialFormat.PreparePixel(Pixel);
  6008. for i := 0 to Info.biWidth-1 do begin
  6009. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  6010. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  6011. FormatDesc.Map(Pixel, aData, DestMD);
  6012. end;
  6013. end;
  6014. begin
  6015. result := false;
  6016. BmpFormat := tfEmpty;
  6017. SpecialFormat := nil;
  6018. LineBuf := nil;
  6019. SourceMD := nil;
  6020. DestMD := nil;
  6021. // Header
  6022. StartPos := aStream.Position;
  6023. aStream.Read(Header{%H-}, SizeOf(Header));
  6024. if Header.bfType = BMP_MAGIC then begin
  6025. try try
  6026. BmpFormat := ReadInfo(Info, Mask);
  6027. SpecialFormat := ReadColorTable(BmpFormat, Info);
  6028. if not Assigned(SpecialFormat) then
  6029. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  6030. aStream.Position := StartPos + Header.bfOffBits;
  6031. if (BmpFormat <> tfEmpty) then begin
  6032. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  6033. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  6034. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  6035. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  6036. //get Memory
  6037. DestMD := FormatDesc.CreateMappingData;
  6038. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  6039. GetMem(ImageData, ImageSize);
  6040. if Assigned(SpecialFormat) then begin
  6041. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  6042. SourceMD := SpecialFormat.CreateMappingData;
  6043. end;
  6044. //read Data
  6045. try try
  6046. FillChar(ImageData^, ImageSize, $FF);
  6047. TmpData := ImageData;
  6048. if (Info.biHeight > 0) then
  6049. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  6050. for i := 0 to Abs(Info.biHeight)-1 do begin
  6051. if Assigned(SpecialFormat) then
  6052. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  6053. else
  6054. aStream.Read(TmpData^, wbLineSize); //else only read data
  6055. if (Info.biHeight > 0) then
  6056. dec(TmpData, wbLineSize)
  6057. else
  6058. inc(TmpData, wbLineSize);
  6059. aStream.Read(PaddingBuff{%H-}, Padding);
  6060. end;
  6061. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6062. result := true;
  6063. finally
  6064. if Assigned(LineBuf) then
  6065. FreeMem(LineBuf);
  6066. if Assigned(SourceMD) then
  6067. SpecialFormat.FreeMappingData(SourceMD);
  6068. FormatDesc.FreeMappingData(DestMD);
  6069. end;
  6070. except
  6071. if Assigned(ImageData) then
  6072. FreeMem(ImageData);
  6073. raise;
  6074. end;
  6075. end else
  6076. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6077. except
  6078. aStream.Position := StartPos;
  6079. raise;
  6080. end;
  6081. finally
  6082. FreeAndNil(SpecialFormat);
  6083. end;
  6084. end
  6085. else aStream.Position := StartPos;
  6086. end;
  6087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6088. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6089. var
  6090. Header: TBMPHeader;
  6091. Info: TBMPInfo;
  6092. Converter: TFormatDescriptor;
  6093. FormatDesc: TFormatDescriptor;
  6094. SourceFD, DestFD: Pointer;
  6095. pData, srcData, dstData, ConvertBuffer: pByte;
  6096. Pixel: TglBitmapPixelData;
  6097. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6098. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6099. PaddingBuff: Cardinal;
  6100. function GetLineWidth : Integer;
  6101. begin
  6102. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6103. end;
  6104. begin
  6105. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6106. raise EglBitmapUnsupportedFormat.Create(Format);
  6107. Converter := nil;
  6108. FormatDesc := TFormatDescriptor.Get(Format);
  6109. ImageSize := FormatDesc.GetSize(Dimension);
  6110. FillChar(Header{%H-}, SizeOf(Header), 0);
  6111. Header.bfType := BMP_MAGIC;
  6112. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6113. Header.bfReserved1 := 0;
  6114. Header.bfReserved2 := 0;
  6115. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6116. FillChar(Info{%H-}, SizeOf(Info), 0);
  6117. Info.biSize := SizeOf(Info);
  6118. Info.biWidth := Width;
  6119. Info.biHeight := Height;
  6120. Info.biPlanes := 1;
  6121. Info.biCompression := BMP_COMP_RGB;
  6122. Info.biSizeImage := ImageSize;
  6123. try
  6124. case Format of
  6125. tfLuminance4: begin
  6126. Info.biBitCount := 4;
  6127. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  6128. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  6129. Converter := TbmpColorTableFormat.Create;
  6130. with (Converter as TbmpColorTableFormat) do begin
  6131. PixelSize := 0.5;
  6132. Format := Format;
  6133. Range := glBitmapColorRec($F, $F, $F, $0);
  6134. CreateColorTable;
  6135. end;
  6136. end;
  6137. tfR3G3B2, tfLuminance8: begin
  6138. Info.biBitCount := 8;
  6139. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6140. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6141. Converter := TbmpColorTableFormat.Create;
  6142. with (Converter as TbmpColorTableFormat) do begin
  6143. PixelSize := 1;
  6144. Format := Format;
  6145. if (Format = tfR3G3B2) then begin
  6146. Range := glBitmapColorRec($7, $7, $3, $0);
  6147. Shift := glBitmapShiftRec(0, 3, 6, 0);
  6148. end else
  6149. Range := glBitmapColorRec($FF, $FF, $FF, $0);
  6150. CreateColorTable;
  6151. end;
  6152. end;
  6153. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  6154. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  6155. Info.biBitCount := 16;
  6156. Info.biCompression := BMP_COMP_BITFIELDS;
  6157. end;
  6158. tfBGR8, tfRGB8: begin
  6159. Info.biBitCount := 24;
  6160. if (Format = tfRGB8) then
  6161. Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6162. end;
  6163. tfRGB10, tfRGB10A2, tfRGBA8,
  6164. tfBGR10, tfBGR10A2, tfBGRA8: begin
  6165. Info.biBitCount := 32;
  6166. Info.biCompression := BMP_COMP_BITFIELDS;
  6167. end;
  6168. else
  6169. raise EglBitmapUnsupportedFormat.Create(Format);
  6170. end;
  6171. Info.biXPelsPerMeter := 2835;
  6172. Info.biYPelsPerMeter := 2835;
  6173. // prepare bitmasks
  6174. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6175. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6176. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6177. RedMask := FormatDesc.RedMask;
  6178. GreenMask := FormatDesc.GreenMask;
  6179. BlueMask := FormatDesc.BlueMask;
  6180. AlphaMask := FormatDesc.AlphaMask;
  6181. end;
  6182. // headers
  6183. aStream.Write(Header, SizeOf(Header));
  6184. aStream.Write(Info, SizeOf(Info));
  6185. // colortable
  6186. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6187. with (Converter as TbmpColorTableFormat) do
  6188. aStream.Write(ColorTable[0].b,
  6189. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6190. // bitmasks
  6191. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6192. aStream.Write(RedMask, SizeOf(Cardinal));
  6193. aStream.Write(GreenMask, SizeOf(Cardinal));
  6194. aStream.Write(BlueMask, SizeOf(Cardinal));
  6195. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6196. end;
  6197. // image data
  6198. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  6199. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6200. Padding := GetLineWidth - wbLineSize;
  6201. PaddingBuff := 0;
  6202. pData := Data;
  6203. inc(pData, (Height-1) * rbLineSize);
  6204. // prepare row buffer. But only for RGB because RGBA supports color masks
  6205. // so it's possible to change color within the image.
  6206. if Assigned(Converter) then begin
  6207. FormatDesc.PreparePixel(Pixel);
  6208. GetMem(ConvertBuffer, wbLineSize);
  6209. SourceFD := FormatDesc.CreateMappingData;
  6210. DestFD := Converter.CreateMappingData;
  6211. end else
  6212. ConvertBuffer := nil;
  6213. try
  6214. for LineIdx := 0 to Height - 1 do begin
  6215. // preparing row
  6216. if Assigned(Converter) then begin
  6217. srcData := pData;
  6218. dstData := ConvertBuffer;
  6219. for PixelIdx := 0 to Info.biWidth-1 do begin
  6220. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6221. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6222. Converter.Map(Pixel, dstData, DestFD);
  6223. end;
  6224. aStream.Write(ConvertBuffer^, wbLineSize);
  6225. end else begin
  6226. aStream.Write(pData^, rbLineSize);
  6227. end;
  6228. dec(pData, rbLineSize);
  6229. if (Padding > 0) then
  6230. aStream.Write(PaddingBuff, Padding);
  6231. end;
  6232. finally
  6233. // destroy row buffer
  6234. if Assigned(ConvertBuffer) then begin
  6235. FormatDesc.FreeMappingData(SourceFD);
  6236. Converter.FreeMappingData(DestFD);
  6237. FreeMem(ConvertBuffer);
  6238. end;
  6239. end;
  6240. finally
  6241. if Assigned(Converter) then
  6242. Converter.Free;
  6243. end;
  6244. end;
  6245. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6246. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6247. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6248. type
  6249. TTGAHeader = packed record
  6250. ImageID: Byte;
  6251. ColorMapType: Byte;
  6252. ImageType: Byte;
  6253. //ColorMapSpec: Array[0..4] of Byte;
  6254. ColorMapStart: Word;
  6255. ColorMapLength: Word;
  6256. ColorMapEntrySize: Byte;
  6257. OrigX: Word;
  6258. OrigY: Word;
  6259. Width: Word;
  6260. Height: Word;
  6261. Bpp: Byte;
  6262. ImageDesc: Byte;
  6263. end;
  6264. const
  6265. TGA_UNCOMPRESSED_RGB = 2;
  6266. TGA_UNCOMPRESSED_GRAY = 3;
  6267. TGA_COMPRESSED_RGB = 10;
  6268. TGA_COMPRESSED_GRAY = 11;
  6269. TGA_NONE_COLOR_TABLE = 0;
  6270. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6271. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6272. var
  6273. Header: TTGAHeader;
  6274. ImageData: System.PByte;
  6275. StartPosition: Int64;
  6276. PixelSize, LineSize: Integer;
  6277. tgaFormat: TglBitmapFormat;
  6278. FormatDesc: TFormatDescriptor;
  6279. Counter: packed record
  6280. X, Y: packed record
  6281. low, high, dir: Integer;
  6282. end;
  6283. end;
  6284. const
  6285. CACHE_SIZE = $4000;
  6286. ////////////////////////////////////////////////////////////////////////////////////////
  6287. procedure ReadUncompressed;
  6288. var
  6289. i, j: Integer;
  6290. buf, tmp1, tmp2: System.PByte;
  6291. begin
  6292. buf := nil;
  6293. if (Counter.X.dir < 0) then
  6294. GetMem(buf, LineSize);
  6295. try
  6296. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6297. tmp1 := ImageData;
  6298. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6299. if (Counter.X.dir < 0) then begin //flip X
  6300. aStream.Read(buf^, LineSize);
  6301. tmp2 := buf;
  6302. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6303. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6304. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6305. tmp1^ := tmp2^;
  6306. inc(tmp1);
  6307. inc(tmp2);
  6308. end;
  6309. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6310. end;
  6311. end else
  6312. aStream.Read(tmp1^, LineSize);
  6313. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6314. end;
  6315. finally
  6316. if Assigned(buf) then
  6317. FreeMem(buf);
  6318. end;
  6319. end;
  6320. ////////////////////////////////////////////////////////////////////////////////////////
  6321. procedure ReadCompressed;
  6322. /////////////////////////////////////////////////////////////////
  6323. var
  6324. TmpData: System.PByte;
  6325. LinePixelsRead: Integer;
  6326. procedure CheckLine;
  6327. begin
  6328. if (LinePixelsRead >= Header.Width) then begin
  6329. LinePixelsRead := 0;
  6330. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6331. TmpData := ImageData;
  6332. inc(TmpData, Counter.Y.low * LineSize); //set line
  6333. if (Counter.X.dir < 0) then //if x flipped then
  6334. inc(TmpData, LineSize - PixelSize); //set last pixel
  6335. end;
  6336. end;
  6337. /////////////////////////////////////////////////////////////////
  6338. var
  6339. Cache: PByte;
  6340. CacheSize, CachePos: Integer;
  6341. procedure CachedRead(out Buffer; Count: Integer);
  6342. var
  6343. BytesRead: Integer;
  6344. begin
  6345. if (CachePos + Count > CacheSize) then begin
  6346. //if buffer overflow save non read bytes
  6347. BytesRead := 0;
  6348. if (CacheSize - CachePos > 0) then begin
  6349. BytesRead := CacheSize - CachePos;
  6350. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6351. inc(CachePos, BytesRead);
  6352. end;
  6353. //load cache from file
  6354. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6355. aStream.Read(Cache^, CacheSize);
  6356. CachePos := 0;
  6357. //read rest of requested bytes
  6358. if (Count - BytesRead > 0) then begin
  6359. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6360. inc(CachePos, Count - BytesRead);
  6361. end;
  6362. end else begin
  6363. //if no buffer overflow just read the data
  6364. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6365. inc(CachePos, Count);
  6366. end;
  6367. end;
  6368. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6369. begin
  6370. case PixelSize of
  6371. 1: begin
  6372. aBuffer^ := aData^;
  6373. inc(aBuffer, Counter.X.dir);
  6374. end;
  6375. 2: begin
  6376. PWord(aBuffer)^ := PWord(aData)^;
  6377. inc(aBuffer, 2 * Counter.X.dir);
  6378. end;
  6379. 3: begin
  6380. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6381. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6382. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6383. inc(aBuffer, 3 * Counter.X.dir);
  6384. end;
  6385. 4: begin
  6386. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6387. inc(aBuffer, 4 * Counter.X.dir);
  6388. end;
  6389. end;
  6390. end;
  6391. var
  6392. TotalPixelsToRead, TotalPixelsRead: Integer;
  6393. Temp: Byte;
  6394. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6395. PixelRepeat: Boolean;
  6396. PixelsToRead, PixelCount: Integer;
  6397. begin
  6398. CacheSize := 0;
  6399. CachePos := 0;
  6400. TotalPixelsToRead := Header.Width * Header.Height;
  6401. TotalPixelsRead := 0;
  6402. LinePixelsRead := 0;
  6403. GetMem(Cache, CACHE_SIZE);
  6404. try
  6405. TmpData := ImageData;
  6406. inc(TmpData, Counter.Y.low * LineSize); //set line
  6407. if (Counter.X.dir < 0) then //if x flipped then
  6408. inc(TmpData, LineSize - PixelSize); //set last pixel
  6409. repeat
  6410. //read CommandByte
  6411. CachedRead(Temp, 1);
  6412. PixelRepeat := (Temp and $80) > 0;
  6413. PixelsToRead := (Temp and $7F) + 1;
  6414. inc(TotalPixelsRead, PixelsToRead);
  6415. if PixelRepeat then
  6416. CachedRead(buf[0], PixelSize);
  6417. while (PixelsToRead > 0) do begin
  6418. CheckLine;
  6419. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6420. while (PixelCount > 0) do begin
  6421. if not PixelRepeat then
  6422. CachedRead(buf[0], PixelSize);
  6423. PixelToBuffer(@buf[0], TmpData);
  6424. inc(LinePixelsRead);
  6425. dec(PixelsToRead);
  6426. dec(PixelCount);
  6427. end;
  6428. end;
  6429. until (TotalPixelsRead >= TotalPixelsToRead);
  6430. finally
  6431. FreeMem(Cache);
  6432. end;
  6433. end;
  6434. function IsGrayFormat: Boolean;
  6435. begin
  6436. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6437. end;
  6438. begin
  6439. result := false;
  6440. // reading header to test file and set cursor back to begin
  6441. StartPosition := aStream.Position;
  6442. aStream.Read(Header{%H-}, SizeOf(Header));
  6443. // no colormapped files
  6444. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6445. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6446. begin
  6447. try
  6448. if Header.ImageID <> 0 then // skip image ID
  6449. aStream.Position := aStream.Position + Header.ImageID;
  6450. tgaFormat := tfEmpty;
  6451. case Header.Bpp of
  6452. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6453. 0: tgaFormat := tfLuminance8;
  6454. 8: tgaFormat := tfAlpha8;
  6455. end;
  6456. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6457. 0: tgaFormat := tfLuminance16;
  6458. 8: tgaFormat := tfLuminance8Alpha8;
  6459. end else case (Header.ImageDesc and $F) of
  6460. 0: tgaFormat := tfBGR5;
  6461. 1: tgaFormat := tfBGR5A1;
  6462. 4: tgaFormat := tfBGRA4;
  6463. end;
  6464. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6465. 0: tgaFormat := tfBGR8;
  6466. end;
  6467. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6468. 2: tgaFormat := tfBGR10A2;
  6469. 8: tgaFormat := tfBGRA8;
  6470. end;
  6471. end;
  6472. if (tgaFormat = tfEmpty) then
  6473. raise EglBitmap.Create('LoadTga - unsupported format');
  6474. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6475. PixelSize := FormatDesc.GetSize(1, 1);
  6476. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6477. GetMem(ImageData, LineSize * Header.Height);
  6478. try
  6479. //column direction
  6480. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6481. Counter.X.low := Header.Height-1;;
  6482. Counter.X.high := 0;
  6483. Counter.X.dir := -1;
  6484. end else begin
  6485. Counter.X.low := 0;
  6486. Counter.X.high := Header.Height-1;
  6487. Counter.X.dir := 1;
  6488. end;
  6489. // Row direction
  6490. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6491. Counter.Y.low := 0;
  6492. Counter.Y.high := Header.Height-1;
  6493. Counter.Y.dir := 1;
  6494. end else begin
  6495. Counter.Y.low := Header.Height-1;;
  6496. Counter.Y.high := 0;
  6497. Counter.Y.dir := -1;
  6498. end;
  6499. // Read Image
  6500. case Header.ImageType of
  6501. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6502. ReadUncompressed;
  6503. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6504. ReadCompressed;
  6505. end;
  6506. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6507. result := true;
  6508. except
  6509. if Assigned(ImageData) then
  6510. FreeMem(ImageData);
  6511. raise;
  6512. end;
  6513. finally
  6514. aStream.Position := StartPosition;
  6515. end;
  6516. end
  6517. else aStream.Position := StartPosition;
  6518. end;
  6519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6520. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6521. var
  6522. Header: TTGAHeader;
  6523. LineSize, Size, x, y: Integer;
  6524. Pixel: TglBitmapPixelData;
  6525. LineBuf, SourceData, DestData: PByte;
  6526. SourceMD, DestMD: Pointer;
  6527. FormatDesc: TFormatDescriptor;
  6528. Converter: TFormatDescriptor;
  6529. begin
  6530. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6531. raise EglBitmapUnsupportedFormat.Create(Format);
  6532. //prepare header
  6533. FillChar(Header{%H-}, SizeOf(Header), 0);
  6534. //set ImageType
  6535. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6536. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6537. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6538. else
  6539. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6540. //set BitsPerPixel
  6541. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6542. Header.Bpp := 8
  6543. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6544. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6545. Header.Bpp := 16
  6546. else if (Format in [tfBGR8, tfRGB8]) then
  6547. Header.Bpp := 24
  6548. else
  6549. Header.Bpp := 32;
  6550. //set AlphaBitCount
  6551. case Format of
  6552. tfRGB5A1, tfBGR5A1:
  6553. Header.ImageDesc := 1 and $F;
  6554. tfRGB10A2, tfBGR10A2:
  6555. Header.ImageDesc := 2 and $F;
  6556. tfRGBA4, tfBGRA4:
  6557. Header.ImageDesc := 4 and $F;
  6558. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6559. Header.ImageDesc := 8 and $F;
  6560. end;
  6561. Header.Width := Width;
  6562. Header.Height := Height;
  6563. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6564. aStream.Write(Header, SizeOf(Header));
  6565. // convert RGB(A) to BGR(A)
  6566. Converter := nil;
  6567. FormatDesc := TFormatDescriptor.Get(Format);
  6568. Size := FormatDesc.GetSize(Dimension);
  6569. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6570. if (FormatDesc.RGBInverted = tfEmpty) then
  6571. raise EglBitmap.Create('inverted RGB format is empty');
  6572. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6573. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6574. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6575. raise EglBitmap.Create('invalid inverted RGB format');
  6576. end;
  6577. if Assigned(Converter) then begin
  6578. LineSize := FormatDesc.GetSize(Width, 1);
  6579. GetMem(LineBuf, LineSize);
  6580. SourceMD := FormatDesc.CreateMappingData;
  6581. DestMD := Converter.CreateMappingData;
  6582. try
  6583. SourceData := Data;
  6584. for y := 0 to Height-1 do begin
  6585. DestData := LineBuf;
  6586. for x := 0 to Width-1 do begin
  6587. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6588. Converter.Map(Pixel, DestData, DestMD);
  6589. end;
  6590. aStream.Write(LineBuf^, LineSize);
  6591. end;
  6592. finally
  6593. FreeMem(LineBuf);
  6594. FormatDesc.FreeMappingData(SourceMD);
  6595. FormatDesc.FreeMappingData(DestMD);
  6596. end;
  6597. end else
  6598. aStream.Write(Data^, Size);
  6599. end;
  6600. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6601. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6602. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6603. const
  6604. DDS_MAGIC: Cardinal = $20534444;
  6605. // DDS_header.dwFlags
  6606. DDSD_CAPS = $00000001;
  6607. DDSD_HEIGHT = $00000002;
  6608. DDSD_WIDTH = $00000004;
  6609. DDSD_PIXELFORMAT = $00001000;
  6610. // DDS_header.sPixelFormat.dwFlags
  6611. DDPF_ALPHAPIXELS = $00000001;
  6612. DDPF_ALPHA = $00000002;
  6613. DDPF_FOURCC = $00000004;
  6614. DDPF_RGB = $00000040;
  6615. DDPF_LUMINANCE = $00020000;
  6616. // DDS_header.sCaps.dwCaps1
  6617. DDSCAPS_TEXTURE = $00001000;
  6618. // DDS_header.sCaps.dwCaps2
  6619. DDSCAPS2_CUBEMAP = $00000200;
  6620. D3DFMT_DXT1 = $31545844;
  6621. D3DFMT_DXT3 = $33545844;
  6622. D3DFMT_DXT5 = $35545844;
  6623. type
  6624. TDDSPixelFormat = packed record
  6625. dwSize: Cardinal;
  6626. dwFlags: Cardinal;
  6627. dwFourCC: Cardinal;
  6628. dwRGBBitCount: Cardinal;
  6629. dwRBitMask: Cardinal;
  6630. dwGBitMask: Cardinal;
  6631. dwBBitMask: Cardinal;
  6632. dwABitMask: Cardinal;
  6633. end;
  6634. TDDSCaps = packed record
  6635. dwCaps1: Cardinal;
  6636. dwCaps2: Cardinal;
  6637. dwDDSX: Cardinal;
  6638. dwReserved: Cardinal;
  6639. end;
  6640. TDDSHeader = packed record
  6641. dwSize: Cardinal;
  6642. dwFlags: Cardinal;
  6643. dwHeight: Cardinal;
  6644. dwWidth: Cardinal;
  6645. dwPitchOrLinearSize: Cardinal;
  6646. dwDepth: Cardinal;
  6647. dwMipMapCount: Cardinal;
  6648. dwReserved: array[0..10] of Cardinal;
  6649. PixelFormat: TDDSPixelFormat;
  6650. Caps: TDDSCaps;
  6651. dwReserved2: Cardinal;
  6652. end;
  6653. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6654. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6655. var
  6656. Header: TDDSHeader;
  6657. Converter: TbmpBitfieldFormat;
  6658. function GetDDSFormat: TglBitmapFormat;
  6659. var
  6660. fd: TFormatDescriptor;
  6661. i: Integer;
  6662. Range: TglBitmapColorRec;
  6663. match: Boolean;
  6664. begin
  6665. result := tfEmpty;
  6666. with Header.PixelFormat do begin
  6667. // Compresses
  6668. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6669. case Header.PixelFormat.dwFourCC of
  6670. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6671. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6672. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6673. end;
  6674. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6675. //find matching format
  6676. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6677. fd := TFormatDescriptor.Get(result);
  6678. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6679. (8 * fd.PixelSize = dwRGBBitCount) then
  6680. exit;
  6681. end;
  6682. //find format with same Range
  6683. Range.r := dwRBitMask;
  6684. Range.g := dwGBitMask;
  6685. Range.b := dwBBitMask;
  6686. Range.a := dwABitMask;
  6687. for i := 0 to 3 do begin
  6688. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6689. Range.arr[i] := Range.arr[i] shr 1;
  6690. end;
  6691. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6692. fd := TFormatDescriptor.Get(result);
  6693. match := true;
  6694. for i := 0 to 3 do
  6695. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6696. match := false;
  6697. break;
  6698. end;
  6699. if match then
  6700. break;
  6701. end;
  6702. //no format with same range found -> use default
  6703. if (result = tfEmpty) then begin
  6704. if (dwABitMask > 0) then
  6705. result := tfBGRA8
  6706. else
  6707. result := tfBGR8;
  6708. end;
  6709. Converter := TbmpBitfieldFormat.Create;
  6710. Converter.RedMask := dwRBitMask;
  6711. Converter.GreenMask := dwGBitMask;
  6712. Converter.BlueMask := dwBBitMask;
  6713. Converter.AlphaMask := dwABitMask;
  6714. Converter.PixelSize := dwRGBBitCount / 8;
  6715. end;
  6716. end;
  6717. end;
  6718. var
  6719. StreamPos: Int64;
  6720. x, y, LineSize, RowSize, Magic: Cardinal;
  6721. NewImage, TmpData, RowData, SrcData: System.PByte;
  6722. SourceMD, DestMD: Pointer;
  6723. Pixel: TglBitmapPixelData;
  6724. ddsFormat: TglBitmapFormat;
  6725. FormatDesc: TFormatDescriptor;
  6726. begin
  6727. result := false;
  6728. Converter := nil;
  6729. StreamPos := aStream.Position;
  6730. // Magic
  6731. aStream.Read(Magic{%H-}, sizeof(Magic));
  6732. if (Magic <> DDS_MAGIC) then begin
  6733. aStream.Position := StreamPos;
  6734. exit;
  6735. end;
  6736. //Header
  6737. aStream.Read(Header{%H-}, sizeof(Header));
  6738. if (Header.dwSize <> SizeOf(Header)) or
  6739. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6740. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6741. begin
  6742. aStream.Position := StreamPos;
  6743. exit;
  6744. end;
  6745. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6746. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  6747. ddsFormat := GetDDSFormat;
  6748. try
  6749. if (ddsFormat = tfEmpty) then
  6750. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6751. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6752. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6753. GetMem(NewImage, Header.dwHeight * LineSize);
  6754. try
  6755. TmpData := NewImage;
  6756. //Converter needed
  6757. if Assigned(Converter) then begin
  6758. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6759. GetMem(RowData, RowSize);
  6760. SourceMD := Converter.CreateMappingData;
  6761. DestMD := FormatDesc.CreateMappingData;
  6762. try
  6763. for y := 0 to Header.dwHeight-1 do begin
  6764. TmpData := NewImage;
  6765. inc(TmpData, y * LineSize);
  6766. SrcData := RowData;
  6767. aStream.Read(SrcData^, RowSize);
  6768. for x := 0 to Header.dwWidth-1 do begin
  6769. Converter.Unmap(SrcData, Pixel, SourceMD);
  6770. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6771. FormatDesc.Map(Pixel, TmpData, DestMD);
  6772. end;
  6773. end;
  6774. finally
  6775. Converter.FreeMappingData(SourceMD);
  6776. FormatDesc.FreeMappingData(DestMD);
  6777. FreeMem(RowData);
  6778. end;
  6779. end else
  6780. // Compressed
  6781. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6782. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6783. for Y := 0 to Header.dwHeight-1 do begin
  6784. aStream.Read(TmpData^, RowSize);
  6785. Inc(TmpData, LineSize);
  6786. end;
  6787. end else
  6788. // Uncompressed
  6789. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6790. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6791. for Y := 0 to Header.dwHeight-1 do begin
  6792. aStream.Read(TmpData^, RowSize);
  6793. Inc(TmpData, LineSize);
  6794. end;
  6795. end else
  6796. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6797. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  6798. result := true;
  6799. except
  6800. if Assigned(NewImage) then
  6801. FreeMem(NewImage);
  6802. raise;
  6803. end;
  6804. finally
  6805. FreeAndNil(Converter);
  6806. end;
  6807. end;
  6808. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6809. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6810. var
  6811. Header: TDDSHeader;
  6812. FormatDesc: TFormatDescriptor;
  6813. begin
  6814. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6815. raise EglBitmapUnsupportedFormat.Create(Format);
  6816. FormatDesc := TFormatDescriptor.Get(Format);
  6817. // Generell
  6818. FillChar(Header{%H-}, SizeOf(Header), 0);
  6819. Header.dwSize := SizeOf(Header);
  6820. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6821. Header.dwWidth := Max(1, Width);
  6822. Header.dwHeight := Max(1, Height);
  6823. // Caps
  6824. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6825. // Pixelformat
  6826. Header.PixelFormat.dwSize := sizeof(Header);
  6827. if (FormatDesc.IsCompressed) then begin
  6828. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6829. case Format of
  6830. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6831. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6832. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6833. end;
  6834. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6835. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6836. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6837. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6838. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6839. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6840. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6841. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6842. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6843. end else begin
  6844. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6845. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6846. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6847. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6848. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6849. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6850. end;
  6851. if (FormatDesc.HasAlpha) then
  6852. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6853. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6854. aStream.Write(Header, SizeOf(Header));
  6855. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6856. end;
  6857. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6858. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6859. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6860. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6861. const aWidth: Integer; const aHeight: Integer);
  6862. var
  6863. pTemp: pByte;
  6864. Size: Integer;
  6865. begin
  6866. if (aHeight > 1) then begin
  6867. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  6868. GetMem(pTemp, Size);
  6869. try
  6870. Move(aData^, pTemp^, Size);
  6871. FreeMem(aData);
  6872. aData := nil;
  6873. except
  6874. FreeMem(pTemp);
  6875. raise;
  6876. end;
  6877. end else
  6878. pTemp := aData;
  6879. inherited SetDataPointer(pTemp, aFormat, aWidth);
  6880. end;
  6881. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6882. function TglBitmap1D.FlipHorz: Boolean;
  6883. var
  6884. Col: Integer;
  6885. pTempDest, pDest, pSource: PByte;
  6886. begin
  6887. result := inherited FlipHorz;
  6888. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  6889. pSource := Data;
  6890. GetMem(pDest, fRowSize);
  6891. try
  6892. pTempDest := pDest;
  6893. Inc(pTempDest, fRowSize);
  6894. for Col := 0 to Width-1 do begin
  6895. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  6896. Move(pSource^, pTempDest^, fPixelSize);
  6897. Inc(pSource, fPixelSize);
  6898. end;
  6899. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  6900. result := true;
  6901. except
  6902. if Assigned(pDest) then
  6903. FreeMem(pDest);
  6904. raise;
  6905. end;
  6906. end;
  6907. end;
  6908. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6909. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  6910. var
  6911. FormatDesc: TFormatDescriptor;
  6912. begin
  6913. // Upload data
  6914. FormatDesc := TFormatDescriptor.Get(Format);
  6915. if FormatDesc.IsCompressed then begin
  6916. if not Assigned(glCompressedTexImage1D) then
  6917. raise EglBitmap.Create('compressed formats not supported by video adapter');
  6918. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  6919. end else if aBuildWithGlu then
  6920. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6921. else
  6922. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6923. // Free Data
  6924. if (FreeDataAfterGenTexture) then
  6925. FreeData;
  6926. end;
  6927. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6928. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  6929. var
  6930. BuildWithGlu, TexRec: Boolean;
  6931. TexSize: Integer;
  6932. begin
  6933. if Assigned(Data) then begin
  6934. // Check Texture Size
  6935. if (aTestTextureSize) then begin
  6936. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6937. if (Width > TexSize) then
  6938. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6939. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6940. (Target = GL_TEXTURE_RECTANGLE);
  6941. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6942. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6943. end;
  6944. CreateId;
  6945. SetupParameters(BuildWithGlu);
  6946. UploadData(BuildWithGlu);
  6947. glAreTexturesResident(1, @fID, @fIsResident);
  6948. end;
  6949. end;
  6950. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6951. procedure TglBitmap1D.AfterConstruction;
  6952. begin
  6953. inherited;
  6954. Target := GL_TEXTURE_1D;
  6955. end;
  6956. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6957. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6958. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6959. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6960. begin
  6961. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6962. result := fLines[aIndex]
  6963. else
  6964. result := nil;
  6965. end;
  6966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6967. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6968. const aWidth: Integer; const aHeight: Integer);
  6969. var
  6970. Idx, LineWidth: Integer;
  6971. begin
  6972. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6973. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6974. // Assigning Data
  6975. if Assigned(Data) then begin
  6976. SetLength(fLines, GetHeight);
  6977. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6978. for Idx := 0 to GetHeight-1 do begin
  6979. fLines[Idx] := Data;
  6980. Inc(fLines[Idx], Idx * LineWidth);
  6981. end;
  6982. end
  6983. else SetLength(fLines, 0);
  6984. end else begin
  6985. SetLength(fLines, 0);
  6986. end;
  6987. end;
  6988. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6989. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  6990. var
  6991. FormatDesc: TFormatDescriptor;
  6992. begin
  6993. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6994. FormatDesc := TFormatDescriptor.Get(Format);
  6995. if FormatDesc.IsCompressed then begin
  6996. if not Assigned(glCompressedTexImage2D) then
  6997. raise EglBitmap.Create('compressed formats not supported by video adapter');
  6998. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  6999. end else if aBuildWithGlu then begin
  7000. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  7001. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7002. end else begin
  7003. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  7004. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7005. end;
  7006. // Freigeben
  7007. if (FreeDataAfterGenTexture) then
  7008. FreeData;
  7009. end;
  7010. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7011. procedure TglBitmap2D.AfterConstruction;
  7012. begin
  7013. inherited;
  7014. Target := GL_TEXTURE_2D;
  7015. end;
  7016. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7017. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  7018. var
  7019. Temp: pByte;
  7020. Size, w, h: Integer;
  7021. FormatDesc: TFormatDescriptor;
  7022. begin
  7023. FormatDesc := TFormatDescriptor.Get(aFormat);
  7024. if FormatDesc.IsCompressed then
  7025. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7026. w := aRight - aLeft;
  7027. h := aBottom - aTop;
  7028. Size := FormatDesc.GetSize(w, h);
  7029. GetMem(Temp, Size);
  7030. try
  7031. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7032. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7033. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  7034. FlipVert;
  7035. except
  7036. if Assigned(Temp) then
  7037. FreeMem(Temp);
  7038. raise;
  7039. end;
  7040. end;
  7041. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7042. procedure TglBitmap2D.GetDataFromTexture;
  7043. var
  7044. Temp: PByte;
  7045. TempWidth, TempHeight: Integer;
  7046. TempIntFormat: Cardinal;
  7047. IntFormat, f: TglBitmapFormat;
  7048. FormatDesc: TFormatDescriptor;
  7049. begin
  7050. Bind;
  7051. // Request Data
  7052. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7053. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7054. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7055. IntFormat := tfEmpty;
  7056. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  7057. FormatDesc := TFormatDescriptor.Get(f);
  7058. if (FormatDesc.glInternalFormat = TempIntFormat) then begin
  7059. IntFormat := FormatDesc.Format;
  7060. break;
  7061. end;
  7062. end;
  7063. // Getting data from OpenGL
  7064. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7065. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7066. try
  7067. if FormatDesc.IsCompressed then begin
  7068. if not Assigned(glGetCompressedTexImage) then
  7069. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7070. glGetCompressedTexImage(Target, 0, Temp)
  7071. end else
  7072. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7073. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7074. except
  7075. if Assigned(Temp) then
  7076. FreeMem(Temp);
  7077. raise;
  7078. end;
  7079. end;
  7080. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7081. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7082. var
  7083. BuildWithGlu, PotTex, TexRec: Boolean;
  7084. TexSize: Integer;
  7085. begin
  7086. if Assigned(Data) then begin
  7087. // Check Texture Size
  7088. if (aTestTextureSize) then begin
  7089. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7090. if ((Height > TexSize) or (Width > TexSize)) then
  7091. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7092. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7093. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7094. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7095. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7096. end;
  7097. CreateId;
  7098. SetupParameters(BuildWithGlu);
  7099. UploadData(Target, BuildWithGlu);
  7100. glAreTexturesResident(1, @fID, @fIsResident);
  7101. end;
  7102. end;
  7103. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7104. function TglBitmap2D.FlipHorz: Boolean;
  7105. var
  7106. Col, Row: Integer;
  7107. TempDestData, DestData, SourceData: PByte;
  7108. ImgSize: Integer;
  7109. begin
  7110. result := inherited FlipHorz;
  7111. if Assigned(Data) then begin
  7112. SourceData := Data;
  7113. ImgSize := Height * fRowSize;
  7114. GetMem(DestData, ImgSize);
  7115. try
  7116. TempDestData := DestData;
  7117. Dec(TempDestData, fRowSize + fPixelSize);
  7118. for Row := 0 to Height -1 do begin
  7119. Inc(TempDestData, fRowSize * 2);
  7120. for Col := 0 to Width -1 do begin
  7121. Move(SourceData^, TempDestData^, fPixelSize);
  7122. Inc(SourceData, fPixelSize);
  7123. Dec(TempDestData, fPixelSize);
  7124. end;
  7125. end;
  7126. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  7127. result := true;
  7128. except
  7129. if Assigned(DestData) then
  7130. FreeMem(DestData);
  7131. raise;
  7132. end;
  7133. end;
  7134. end;
  7135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7136. function TglBitmap2D.FlipVert: Boolean;
  7137. var
  7138. Row: Integer;
  7139. TempDestData, DestData, SourceData: PByte;
  7140. begin
  7141. result := inherited FlipVert;
  7142. if Assigned(Data) then begin
  7143. SourceData := Data;
  7144. GetMem(DestData, Height * fRowSize);
  7145. try
  7146. TempDestData := DestData;
  7147. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7148. for Row := 0 to Height -1 do begin
  7149. Move(SourceData^, TempDestData^, fRowSize);
  7150. Dec(TempDestData, fRowSize);
  7151. Inc(SourceData, fRowSize);
  7152. end;
  7153. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  7154. result := true;
  7155. except
  7156. if Assigned(DestData) then
  7157. FreeMem(DestData);
  7158. raise;
  7159. end;
  7160. end;
  7161. end;
  7162. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7163. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7164. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7165. type
  7166. TMatrixItem = record
  7167. X, Y: Integer;
  7168. W: Single;
  7169. end;
  7170. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7171. TglBitmapToNormalMapRec = Record
  7172. Scale: Single;
  7173. Heights: array of Single;
  7174. MatrixU : array of TMatrixItem;
  7175. MatrixV : array of TMatrixItem;
  7176. end;
  7177. const
  7178. ONE_OVER_255 = 1 / 255;
  7179. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7180. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7181. var
  7182. Val: Single;
  7183. begin
  7184. with FuncRec do begin
  7185. Val :=
  7186. Source.Data.r * LUMINANCE_WEIGHT_R +
  7187. Source.Data.g * LUMINANCE_WEIGHT_G +
  7188. Source.Data.b * LUMINANCE_WEIGHT_B;
  7189. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7190. end;
  7191. end;
  7192. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7193. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7194. begin
  7195. with FuncRec do
  7196. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7197. end;
  7198. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7199. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7200. type
  7201. TVec = Array[0..2] of Single;
  7202. var
  7203. Idx: Integer;
  7204. du, dv: Double;
  7205. Len: Single;
  7206. Vec: TVec;
  7207. function GetHeight(X, Y: Integer): Single;
  7208. begin
  7209. with FuncRec do begin
  7210. X := Max(0, Min(Size.X -1, X));
  7211. Y := Max(0, Min(Size.Y -1, Y));
  7212. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7213. end;
  7214. end;
  7215. begin
  7216. with FuncRec do begin
  7217. with PglBitmapToNormalMapRec(Args)^ do begin
  7218. du := 0;
  7219. for Idx := Low(MatrixU) to High(MatrixU) do
  7220. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7221. dv := 0;
  7222. for Idx := Low(MatrixU) to High(MatrixU) do
  7223. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7224. Vec[0] := -du * Scale;
  7225. Vec[1] := -dv * Scale;
  7226. Vec[2] := 1;
  7227. end;
  7228. // Normalize
  7229. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7230. if Len <> 0 then begin
  7231. Vec[0] := Vec[0] * Len;
  7232. Vec[1] := Vec[1] * Len;
  7233. Vec[2] := Vec[2] * Len;
  7234. end;
  7235. // Farbe zuweisem
  7236. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7237. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7238. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7239. end;
  7240. end;
  7241. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7242. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7243. var
  7244. Rec: TglBitmapToNormalMapRec;
  7245. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7246. begin
  7247. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7248. Matrix[Index].X := X;
  7249. Matrix[Index].Y := Y;
  7250. Matrix[Index].W := W;
  7251. end;
  7252. end;
  7253. begin
  7254. if TFormatDescriptor.Get(Format).IsCompressed then
  7255. raise EglBitmapUnsupportedFormat.Create(Format);
  7256. if aScale > 100 then
  7257. Rec.Scale := 100
  7258. else if aScale < -100 then
  7259. Rec.Scale := -100
  7260. else
  7261. Rec.Scale := aScale;
  7262. SetLength(Rec.Heights, Width * Height);
  7263. try
  7264. case aFunc of
  7265. nm4Samples: begin
  7266. SetLength(Rec.MatrixU, 2);
  7267. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7268. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7269. SetLength(Rec.MatrixV, 2);
  7270. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7271. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7272. end;
  7273. nmSobel: begin
  7274. SetLength(Rec.MatrixU, 6);
  7275. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7276. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7277. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7278. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7279. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7280. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7281. SetLength(Rec.MatrixV, 6);
  7282. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7283. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7284. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7285. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7286. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7287. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7288. end;
  7289. nm3x3: begin
  7290. SetLength(Rec.MatrixU, 6);
  7291. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7292. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7293. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7294. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7295. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7296. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7297. SetLength(Rec.MatrixV, 6);
  7298. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7299. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7300. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7301. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7302. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7303. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7304. end;
  7305. nm5x5: begin
  7306. SetLength(Rec.MatrixU, 20);
  7307. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7308. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7309. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7310. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7311. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7312. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7313. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7314. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7315. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7316. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7317. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7318. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7319. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7320. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7321. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7322. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7323. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7324. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7325. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7326. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7327. SetLength(Rec.MatrixV, 20);
  7328. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7329. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7330. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7331. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7332. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7333. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7334. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7335. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7336. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7337. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7338. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7339. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7340. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7341. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7342. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7343. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7344. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7345. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7346. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7347. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7348. end;
  7349. end;
  7350. // Daten Sammeln
  7351. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7352. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7353. else
  7354. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7355. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7356. finally
  7357. SetLength(Rec.Heights, 0);
  7358. end;
  7359. end;
  7360. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7361. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7362. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7363. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7364. begin
  7365. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7366. end;
  7367. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7368. procedure TglBitmapCubeMap.AfterConstruction;
  7369. begin
  7370. inherited;
  7371. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7372. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7373. SetWrap;
  7374. Target := GL_TEXTURE_CUBE_MAP;
  7375. fGenMode := GL_REFLECTION_MAP;
  7376. end;
  7377. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7378. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7379. var
  7380. BuildWithGlu: Boolean;
  7381. TexSize: Integer;
  7382. begin
  7383. if (aTestTextureSize) then begin
  7384. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7385. if (Height > TexSize) or (Width > TexSize) then
  7386. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7387. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7388. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7389. end;
  7390. if (ID = 0) then
  7391. CreateID;
  7392. SetupParameters(BuildWithGlu);
  7393. UploadData(aCubeTarget, BuildWithGlu);
  7394. end;
  7395. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7396. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
  7397. begin
  7398. inherited Bind (aEnableTextureUnit);
  7399. if aEnableTexCoordsGen then begin
  7400. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7401. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7402. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7403. glEnable(GL_TEXTURE_GEN_S);
  7404. glEnable(GL_TEXTURE_GEN_T);
  7405. glEnable(GL_TEXTURE_GEN_R);
  7406. end;
  7407. end;
  7408. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7409. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
  7410. begin
  7411. inherited Unbind(aDisableTextureUnit);
  7412. if aDisableTexCoordsGen then begin
  7413. glDisable(GL_TEXTURE_GEN_S);
  7414. glDisable(GL_TEXTURE_GEN_T);
  7415. glDisable(GL_TEXTURE_GEN_R);
  7416. end;
  7417. end;
  7418. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7419. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7420. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7421. type
  7422. TVec = Array[0..2] of Single;
  7423. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7424. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7425. TglBitmapNormalMapRec = record
  7426. HalfSize : Integer;
  7427. Func: TglBitmapNormalMapGetVectorFunc;
  7428. end;
  7429. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7430. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7431. begin
  7432. aVec[0] := aHalfSize;
  7433. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7434. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7435. end;
  7436. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7437. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7438. begin
  7439. aVec[0] := - aHalfSize;
  7440. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7441. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7442. end;
  7443. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7444. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7445. begin
  7446. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7447. aVec[1] := aHalfSize;
  7448. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7449. end;
  7450. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7451. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7452. begin
  7453. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7454. aVec[1] := - aHalfSize;
  7455. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7456. end;
  7457. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7458. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7459. begin
  7460. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7461. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7462. aVec[2] := aHalfSize;
  7463. end;
  7464. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7465. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7466. begin
  7467. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7468. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7469. aVec[2] := - aHalfSize;
  7470. end;
  7471. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7472. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7473. var
  7474. i: Integer;
  7475. Vec: TVec;
  7476. Len: Single;
  7477. begin
  7478. with FuncRec do begin
  7479. with PglBitmapNormalMapRec(Args)^ do begin
  7480. Func(Vec, Position, HalfSize);
  7481. // Normalize
  7482. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7483. if Len <> 0 then begin
  7484. Vec[0] := Vec[0] * Len;
  7485. Vec[1] := Vec[1] * Len;
  7486. Vec[2] := Vec[2] * Len;
  7487. end;
  7488. // Scale Vector and AddVectro
  7489. Vec[0] := Vec[0] * 0.5 + 0.5;
  7490. Vec[1] := Vec[1] * 0.5 + 0.5;
  7491. Vec[2] := Vec[2] * 0.5 + 0.5;
  7492. end;
  7493. // Set Color
  7494. for i := 0 to 2 do
  7495. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7496. end;
  7497. end;
  7498. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7499. procedure TglBitmapNormalMap.AfterConstruction;
  7500. begin
  7501. inherited;
  7502. fGenMode := GL_NORMAL_MAP;
  7503. end;
  7504. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7505. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7506. var
  7507. Rec: TglBitmapNormalMapRec;
  7508. SizeRec: TglBitmapPixelPosition;
  7509. begin
  7510. Rec.HalfSize := aSize div 2;
  7511. FreeDataAfterGenTexture := false;
  7512. SizeRec.Fields := [ffX, ffY];
  7513. SizeRec.X := aSize;
  7514. SizeRec.Y := aSize;
  7515. // Positive X
  7516. Rec.Func := glBitmapNormalMapPosX;
  7517. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7518. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7519. // Negative X
  7520. Rec.Func := glBitmapNormalMapNegX;
  7521. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7522. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7523. // Positive Y
  7524. Rec.Func := glBitmapNormalMapPosY;
  7525. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7526. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7527. // Negative Y
  7528. Rec.Func := glBitmapNormalMapNegY;
  7529. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7530. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7531. // Positive Z
  7532. Rec.Func := glBitmapNormalMapPosZ;
  7533. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7534. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7535. // Negative Z
  7536. Rec.Func := glBitmapNormalMapNegZ;
  7537. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7538. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7539. end;
  7540. initialization
  7541. glBitmapSetDefaultFormat (tfEmpty);
  7542. glBitmapSetDefaultMipmap (mmMipmap);
  7543. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7544. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7545. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7546. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7547. glBitmapSetDefaultDeleteTextureOnFree (true);
  7548. TFormatDescriptor.Init;
  7549. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7550. OpenGLInitialized := false;
  7551. InitOpenGLCS := TCriticalSection.Create;
  7552. {$ENDIF}
  7553. finalization
  7554. TFormatDescriptor.Finalize;
  7555. {$IFDEF GLB_NATIVE_OGL}
  7556. if Assigned(GL_LibHandle) then
  7557. glbFreeLibrary(GL_LibHandle);
  7558. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7559. if Assigned(GLU_LibHandle) then
  7560. glbFreeLibrary(GLU_LibHandle);
  7561. FreeAndNil(InitOpenGLCS);
  7562. {$ENDIF}
  7563. {$ENDIF}
  7564. end.