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.

8648 lines
298 KiB

  1. {***********************************************************
  2. glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  3. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  4. modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
  5. ------------------------------------------------------------
  6. The contents of this file are used with permission, subject to
  7. the Mozilla Public License Version 1.1 (the "License"); you may
  8. not use this file except in compliance with the License. You may
  9. obtain a copy of the License at
  10. http://www.mozilla.org/MPL/MPL-1.1.html
  11. ------------------------------------------------------------
  12. Version 3.0.1
  13. ------------------------------------------------------------
  14. History
  15. 20-11-2013
  16. - refactoring of the complete library
  17. 21-03-2010
  18. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  19. then it's your problem if that isn't true. This prevents the unit for incompatibility
  20. with newer versions of Delphi.
  21. - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  22. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  23. 10-08-2008
  24. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  25. - Additional Datapointer for functioninterface now has the name CustomData
  26. 24-07-2008
  27. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  28. - If you load an texture from an file the property Filename will be set to the name of the file
  29. - Three new properties to attach custom data to the Texture objects
  30. - CustomName (free for use string)
  31. - CustomNameW (free for use widestring)
  32. - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  33. 27-05-2008
  34. - RLE TGAs loaded much faster
  35. 26-05-2008
  36. - fixed some problem with reading RLE TGAs.
  37. 21-05-2008
  38. - function clone now only copys data if it's assigned and now it also copies the ID
  39. - it seems that lazarus dont like comments in comments.
  40. 01-05-2008
  41. - It's possible to set the id of the texture
  42. - define GLB_NO_NATIVE_GL deactivated by default
  43. 27-04-2008
  44. - Now supports the following libraries
  45. - SDL and SDL_image
  46. - libPNG
  47. - libJPEG
  48. - Linux compatibillity via free pascal compatibility (delphi sources optional)
  49. - BMPs now loaded manuel
  50. - Large restructuring
  51. - Property DataPtr now has the name Data
  52. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  53. - Unused Depth removed
  54. - Function FreeData to freeing image data added
  55. 24-10-2007
  56. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  57. 15-11-2006
  58. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  59. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  60. - Function ReadOpenGLExtension is now only intern
  61. 29-06-2006
  62. - pngimage now disabled by default like all other versions.
  63. 26-06-2006
  64. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  65. 22-06-2006
  66. - Fixed some Problem with Delphi 5
  67. - Now uses the newest version of pngimage. Makes saving pngs much easier.
  68. 22-03-2006
  69. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  70. 09-03-2006
  71. - Internal Format ifDepth8 added
  72. - function GrabScreen now supports all uncompressed formats
  73. 31-01-2006
  74. - AddAlphaFromglBitmap implemented
  75. 29-12-2005
  76. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  77. 28-12-2005
  78. - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  79. property Width, Height, Depth are still existing and new property Dimension are avail
  80. 11-12-2005
  81. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  82. 19-10-2005
  83. - Added function GrabScreen to class TglBitmap2D
  84. 18-10-2005
  85. - Added support to Save images
  86. - Added function Clone to Clone Instance
  87. 11-10-2005
  88. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  89. Usefull for Future
  90. - Several speed optimizations
  91. 09-10-2005
  92. - Internal structure change. Loading of TGA, PNG and DDS improved.
  93. Data, format and size will now set directly with SetDataPtr.
  94. - AddFunc now works with all Types of Images and Formats
  95. - Some Funtions moved to Baseclass TglBitmap
  96. 06-10-2005
  97. - Added Support to decompress DXT3 and DXT5 compressed Images.
  98. - Added Mapping to convert data from one format into an other.
  99. 05-10-2005
  100. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  101. supported Input format (supported by GetPixel) into any uncompresed Format
  102. - Added Support to decompress DXT1 compressed Images.
  103. - SwapColors replaced by ConvertTo
  104. 04-10-2005
  105. - Added Support for compressed DDSs
  106. - Added new internal formats (DXT1, DXT3, DXT5)
  107. 29-09-2005
  108. - Parameter Components renamed to InternalFormat
  109. 23-09-2005
  110. - Some AllocMem replaced with GetMem (little speed change)
  111. - better exception handling. Better protection from memory leaks.
  112. 22-09-2005
  113. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
  114. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
  115. 07-09-2005
  116. - Added support for Grayscale textures
  117. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
  118. 10-07-2005
  119. - Added support for GL_VERSION_2_0
  120. - Added support for GL_EXT_texture_filter_anisotropic
  121. 04-07-2005
  122. - Function FillWithColor fills the Image with one Color
  123. - Function LoadNormalMap added
  124. 30-06-2005
  125. - ToNormalMap allows to Create an NormalMap from the Alphachannel
  126. - ToNormalMap now supports Sobel (nmSobel) function.
  127. 29-06-2005
  128. - support for RLE Compressed RGB TGAs added
  129. 28-06-2005
  130. - Class TglBitmapNormalMap added to support Normalmap generation
  131. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
  132. 3 Filters are supported. (4 Samples, 3x3 and 5x5)
  133. 16-06-2005
  134. - Method LoadCubeMapClass removed
  135. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
  136. - virtual abstract method GenTexture in class TglBitmap now is protected
  137. 12-06-2005
  138. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
  139. 10-06-2005
  140. - little enhancement for IsPowerOfTwo
  141. - TglBitmap1D.GenTexture now tests NPOT Textures
  142. 06-06-2005
  143. - some little name changes. All properties or function with Texture in name are
  144. now without texture in name. We have allways texture so we dosn't name it.
  145. 03-06-2005
  146. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
  147. TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
  148. 02-06-2005
  149. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
  150. 25-04-2005
  151. - Function Unbind added
  152. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
  153. 21-04-2005
  154. - class TglBitmapCubeMap added (allows to Create Cubemaps)
  155. 29-03-2005
  156. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
  157. To Enable png's use the define pngimage
  158. 22-03-2005
  159. - New Functioninterface added
  160. - Function GetPixel added
  161. 27-11-2004
  162. - Property BuildMipMaps renamed to MipMap
  163. 21-11-2004
  164. - property Name removed.
  165. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
  166. 22-05-2004
  167. - property name added. Only used in glForms!
  168. 26-11-2003
  169. - property FreeDataAfterGenTexture is now available as default (default = true)
  170. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
  171. - function MoveMemory replaced with function Move (little speed change)
  172. - several calculations stored in variables (little speed change)
  173. 29-09-2003
  174. - property BuildMipsMaps added (default = true)
  175. if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
  176. - property FreeDataAfterGenTexture added (default = true)
  177. if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
  178. - parameter DisableOtherTextureUnits of Bind removed
  179. - parameter FreeDataAfterGeneration of GenTextures removed
  180. 12-09-2003
  181. - TglBitmap dosn't delete data if class was destroyed (fixed)
  182. 09-09-2003
  183. - Bind now enables TextureUnits (by params)
  184. - GenTextures can leave data (by param)
  185. - LoadTextures now optimal
  186. 03-09-2003
  187. - Performance optimization in AddFunc
  188. - procedure Bind moved to subclasses
  189. - Added new Class TglBitmap1D to support real OpenGL 1D Textures
  190. 19-08-2003
  191. - Texturefilter and texturewrap now also as defaults
  192. Minfilter = GL_LINEAR_MIPMAP_LINEAR
  193. Magfilter = GL_LINEAR
  194. Wrap(str) = GL_CLAMP_TO_EDGE
  195. - Added new format tfCompressed to create a compressed texture.
  196. - propertys IsCompressed, TextureSize and IsResident added
  197. IsCompressed and TextureSize only contains data from level 0
  198. 18-08-2003
  199. - Added function AddFunc to add PerPixelEffects to Image
  200. - LoadFromFunc now based on AddFunc
  201. - Invert now based on AddFunc
  202. - SwapColors now based on AddFunc
  203. 16-08-2003
  204. - Added function FlipHorz
  205. 15-08-2003
  206. - Added function LaodFromFunc to create images with function
  207. - Added function FlipVert
  208. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
  209. 29-07-2003
  210. - Added Alphafunctions to calculate alpha per function
  211. - Added Alpha from ColorKey using alphafunctions
  212. 28-07-2003
  213. - First full functionally Version of glBitmap
  214. - Support for 24Bit and 32Bit TGA Pictures added
  215. 25-07-2003
  216. - begin of programming
  217. ***********************************************************}
  218. unit glBitmap;
  219. // Please uncomment the defines below to configure the glBitmap to your preferences.
  220. // If you have configured the unit you can uncomment the warning above.
  221. {$MESSAGE error 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  223. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  225. // activate to enable build-in OpenGL support with statically linked methods
  226. // use dglOpenGL.pas if not enabled
  227. {.$DEFINE GLB_NATIVE_OGL_STATIC}
  228. // activate to enable build-in OpenGL support with dynamically linked methods
  229. // use dglOpenGL.pas if not enabled
  230. {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
  231. // activate to enable the support for SDL_surfaces
  232. {.$DEFINE GLB_SDL}
  233. // activate to enable the support for Delphi (including support for Delphi's (not Lazarus') TBitmap)
  234. {.$DEFINE GLB_DELPHI}
  235. // activate to enable the support for TLazIntfImage from Lazarus
  236. {.$DEFINE GLB_LAZARUS}
  237. // activate to enable the support of SDL_image to load files. (READ ONLY)
  238. // If you enable SDL_image all other libraries will be ignored!
  239. {.$DEFINE GLB_SDL_IMAGE}
  240. // activate to enable Lazarus TPortableNetworkGraphic support
  241. // if you enable this pngImage and libPNG will be ignored
  242. {.$DEFINE GLB_LAZ_PNG}
  243. // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
  244. // if you enable pngimage the libPNG will be ignored
  245. {.$DEFINE GLB_PNGIMAGE}
  246. // activate to use the libPNG -> http://www.libpng.org/
  247. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
  248. {.$DEFINE GLB_LIB_PNG}
  249. // activate to enable Lazarus TJPEGImage support
  250. // if you enable this delphi jpegs and libJPEG will be ignored
  251. {.$DEFINE GLB_LAZ_JPEG}
  252. // if you enable delphi jpegs the libJPEG will be ignored
  253. {.$DEFINE GLB_DELPHI_JPEG}
  254. // activate to use the libJPEG -> http://www.ijg.org/
  255. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
  256. {.$DEFINE GLB_LIB_JPEG}
  257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  258. // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  259. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  260. // Delphi Versions
  261. {$IFDEF fpc}
  262. {$MODE Delphi}
  263. {$IFDEF CPUI386}
  264. {$DEFINE CPU386}
  265. {$ASMMODE INTEL}
  266. {$ENDIF}
  267. {$IFNDEF WINDOWS}
  268. {$linklib c}
  269. {$ENDIF}
  270. {$ENDIF}
  271. // Operation System
  272. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  273. {$DEFINE GLB_WIN}
  274. {$ELSEIF DEFINED(LINUX)}
  275. {$DEFINE GLB_LINUX}
  276. {$IFEND}
  277. // native OpenGL Support
  278. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  279. {$DEFINE GLB_NATIVE_OGL}
  280. {$IFEND}
  281. // checking define combinations
  282. //SDL Image
  283. {$IFDEF GLB_SDL_IMAGE}
  284. {$IFNDEF GLB_SDL}
  285. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  286. {$DEFINE GLB_SDL}
  287. {$ENDIF}
  288. {$IFDEF GLB_LAZ_PNG}
  289. {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  290. {$undef GLB_LAZ_PNG}
  291. {$ENDIF}
  292. {$IFDEF GLB_PNGIMAGE}
  293. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  294. {$undef GLB_PNGIMAGE}
  295. {$ENDIF}
  296. {$IFDEF GLB_LAZ_JPEG}
  297. {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  298. {$undef GLB_LAZ_JPEG}
  299. {$ENDIF}
  300. {$IFDEF GLB_DELPHI_JPEG}
  301. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  302. {$undef GLB_DELPHI_JPEG}
  303. {$ENDIF}
  304. {$IFDEF GLB_LIB_PNG}
  305. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  306. {$undef GLB_LIB_PNG}
  307. {$ENDIF}
  308. {$IFDEF GLB_LIB_JPEG}
  309. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  310. {$undef GLB_LIB_JPEG}
  311. {$ENDIF}
  312. {$DEFINE GLB_SUPPORT_PNG_READ}
  313. {$DEFINE GLB_SUPPORT_JPEG_READ}
  314. {$ENDIF}
  315. // Lazarus TPortableNetworkGraphic
  316. {$IFDEF GLB_LAZ_PNG}
  317. {$IFNDEF GLB_LAZARUS}
  318. {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
  319. {$DEFINE GLB_LAZARUS}
  320. {$ENDIF}
  321. {$IFDEF GLB_PNGIMAGE}
  322. {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  323. {$undef GLB_PNGIMAGE}
  324. {$ENDIF}
  325. {$IFDEF GLB_LIB_PNG}
  326. {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  327. {$undef GLB_LIB_PNG}
  328. {$ENDIF}
  329. {$DEFINE GLB_SUPPORT_PNG_READ}
  330. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  331. {$ENDIF}
  332. // PNG Image
  333. {$IFDEF GLB_PNGIMAGE}
  334. {$IFDEF GLB_LIB_PNG}
  335. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  336. {$undef GLB_LIB_PNG}
  337. {$ENDIF}
  338. {$DEFINE GLB_SUPPORT_PNG_READ}
  339. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  340. {$ENDIF}
  341. // libPNG
  342. {$IFDEF GLB_LIB_PNG}
  343. {$DEFINE GLB_SUPPORT_PNG_READ}
  344. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  345. {$ENDIF}
  346. // Lazarus TJPEGImage
  347. {$IFDEF GLB_LAZ_JPEG}
  348. {$IFNDEF GLB_LAZARUS}
  349. {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
  350. {$DEFINE GLB_LAZARUS}
  351. {$ENDIF}
  352. {$IFDEF GLB_DELPHI_JPEG}
  353. {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
  354. {$undef GLB_DELPHI_JPEG}
  355. {$ENDIF}
  356. {$IFDEF GLB_LIB_JPEG}
  357. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
  358. {$undef GLB_LIB_JPEG}
  359. {$ENDIF}
  360. {$DEFINE GLB_SUPPORT_JPEG_READ}
  361. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  362. {$ENDIF}
  363. // JPEG Image
  364. {$IFDEF GLB_DELPHI_JPEG}
  365. {$IFDEF GLB_LIB_JPEG}
  366. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  367. {$undef GLB_LIB_JPEG}
  368. {$ENDIF}
  369. {$DEFINE GLB_SUPPORT_JPEG_READ}
  370. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  371. {$ENDIF}
  372. // libJPEG
  373. {$IFDEF GLB_LIB_JPEG}
  374. {$DEFINE GLB_SUPPORT_JPEG_READ}
  375. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  376. {$ENDIF}
  377. // native OpenGL
  378. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  379. {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
  380. {$IFEND}
  381. // general options
  382. {$EXTENDEDSYNTAX ON}
  383. {$LONGSTRINGS ON}
  384. {$ALIGN ON}
  385. {$IFNDEF FPC}
  386. {$OPTIMIZATION ON}
  387. {$ENDIF}
  388. interface
  389. uses
  390. {$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
  391. {$IF DEFINED(GLB_WIN) AND
  392. (DEFINED(GLB_NATIVE_OGL) OR
  393. DEFINED(GLB_DELPHI))} windows, {$IFEND}
  394. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  395. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  396. {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$ENDIF}
  397. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  398. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  399. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  400. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  401. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  402. Classes, SysUtils;
  403. {$IFDEF GLB_NATIVE_OGL}
  404. const
  405. GL_TRUE = 1;
  406. GL_FALSE = 0;
  407. GL_ZERO = 0;
  408. GL_ONE = 1;
  409. GL_VERSION = $1F02;
  410. GL_EXTENSIONS = $1F03;
  411. GL_TEXTURE_1D = $0DE0;
  412. GL_TEXTURE_2D = $0DE1;
  413. GL_TEXTURE_RECTANGLE = $84F5;
  414. GL_NORMAL_MAP = $8511;
  415. GL_TEXTURE_CUBE_MAP = $8513;
  416. GL_REFLECTION_MAP = $8512;
  417. GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
  418. GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
  419. GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
  420. GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
  421. GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
  422. GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
  423. GL_TEXTURE_WIDTH = $1000;
  424. GL_TEXTURE_HEIGHT = $1001;
  425. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  426. GL_TEXTURE_SWIZZLE_RGBA = $8E46;
  427. GL_S = $2000;
  428. GL_T = $2001;
  429. GL_R = $2002;
  430. GL_Q = $2003;
  431. GL_TEXTURE_GEN_S = $0C60;
  432. GL_TEXTURE_GEN_T = $0C61;
  433. GL_TEXTURE_GEN_R = $0C62;
  434. GL_TEXTURE_GEN_Q = $0C63;
  435. GL_RED = $1903;
  436. GL_GREEN = $1904;
  437. GL_BLUE = $1905;
  438. GL_ALPHA = $1906;
  439. GL_ALPHA4 = $803B;
  440. GL_ALPHA8 = $803C;
  441. GL_ALPHA12 = $803D;
  442. GL_ALPHA16 = $803E;
  443. GL_LUMINANCE = $1909;
  444. GL_LUMINANCE4 = $803F;
  445. GL_LUMINANCE8 = $8040;
  446. GL_LUMINANCE12 = $8041;
  447. GL_LUMINANCE16 = $8042;
  448. GL_LUMINANCE_ALPHA = $190A;
  449. GL_LUMINANCE4_ALPHA4 = $8043;
  450. GL_LUMINANCE6_ALPHA2 = $8044;
  451. GL_LUMINANCE8_ALPHA8 = $8045;
  452. GL_LUMINANCE12_ALPHA4 = $8046;
  453. GL_LUMINANCE12_ALPHA12 = $8047;
  454. GL_LUMINANCE16_ALPHA16 = $8048;
  455. GL_RGB = $1907;
  456. GL_BGR = $80E0;
  457. GL_R3_G3_B2 = $2A10;
  458. GL_RGB4 = $804F;
  459. GL_RGB5 = $8050;
  460. GL_RGB565 = $8D62;
  461. GL_RGB8 = $8051;
  462. GL_RGB10 = $8052;
  463. GL_RGB12 = $8053;
  464. GL_RGB16 = $8054;
  465. GL_RGBA = $1908;
  466. GL_BGRA = $80E1;
  467. GL_RGBA2 = $8055;
  468. GL_RGBA4 = $8056;
  469. GL_RGB5_A1 = $8057;
  470. GL_RGBA8 = $8058;
  471. GL_RGB10_A2 = $8059;
  472. GL_RGBA12 = $805A;
  473. GL_RGBA16 = $805B;
  474. GL_DEPTH_COMPONENT = $1902;
  475. GL_DEPTH_COMPONENT16 = $81A5;
  476. GL_DEPTH_COMPONENT24 = $81A6;
  477. GL_DEPTH_COMPONENT32 = $81A7;
  478. GL_COMPRESSED_RGB = $84ED;
  479. GL_COMPRESSED_RGBA = $84EE;
  480. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  481. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  482. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  483. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  484. GL_UNSIGNED_BYTE = $1401;
  485. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  486. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  487. GL_UNSIGNED_SHORT = $1403;
  488. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  489. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  490. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  491. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  492. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  493. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  494. GL_UNSIGNED_INT = $1405;
  495. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  496. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  497. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  498. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  499. { Texture Filter }
  500. GL_TEXTURE_MAG_FILTER = $2800;
  501. GL_TEXTURE_MIN_FILTER = $2801;
  502. GL_NEAREST = $2600;
  503. GL_NEAREST_MIPMAP_NEAREST = $2700;
  504. GL_NEAREST_MIPMAP_LINEAR = $2702;
  505. GL_LINEAR = $2601;
  506. GL_LINEAR_MIPMAP_NEAREST = $2701;
  507. GL_LINEAR_MIPMAP_LINEAR = $2703;
  508. { Texture Wrap }
  509. GL_TEXTURE_WRAP_S = $2802;
  510. GL_TEXTURE_WRAP_T = $2803;
  511. GL_TEXTURE_WRAP_R = $8072;
  512. GL_CLAMP = $2900;
  513. GL_REPEAT = $2901;
  514. GL_CLAMP_TO_EDGE = $812F;
  515. GL_CLAMP_TO_BORDER = $812D;
  516. GL_MIRRORED_REPEAT = $8370;
  517. { Other }
  518. GL_GENERATE_MIPMAP = $8191;
  519. GL_TEXTURE_BORDER_COLOR = $1004;
  520. GL_MAX_TEXTURE_SIZE = $0D33;
  521. GL_PACK_ALIGNMENT = $0D05;
  522. GL_UNPACK_ALIGNMENT = $0CF5;
  523. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  524. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  525. GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
  526. GL_TEXTURE_GEN_MODE = $2500;
  527. {$IF DEFINED(GLB_WIN)}
  528. libglu = 'glu32.dll';
  529. libopengl = 'opengl32.dll';
  530. {$ELSEIF DEFINED(GLB_LINUX)}
  531. libglu = 'libGLU.so.1';
  532. libopengl = 'libGL.so.1';
  533. {$IFEND}
  534. type
  535. GLboolean = BYTEBOOL;
  536. GLint = Integer;
  537. GLsizei = Integer;
  538. GLuint = Cardinal;
  539. GLfloat = Single;
  540. GLenum = Cardinal;
  541. PGLvoid = Pointer;
  542. PGLboolean = ^GLboolean;
  543. PGLint = ^GLint;
  544. PGLuint = ^GLuint;
  545. PGLfloat = ^GLfloat;
  546. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  547. TglCompressedTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  548. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  549. {$IF DEFINED(GLB_WIN)}
  550. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  551. {$ELSEIF DEFINED(GLB_LINUX)}
  552. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  553. TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
  554. {$IFEND}
  555. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  556. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  557. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  558. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  559. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  560. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  561. TglTexParameteriv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  562. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  563. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  564. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  565. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  566. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  567. TglTexGeni = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  568. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  569. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  570. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  571. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  572. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  573. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  574. TglTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  575. TglTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  576. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  577. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  578. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  579. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  580. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  581. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  582. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  583. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  584. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  585. procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  586. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  587. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  588. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  589. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  590. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  591. procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  592. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  593. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  594. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  595. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  596. procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  597. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  598. procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  599. procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  600. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  601. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  602. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  603. {$IFEND}
  604. var
  605. GL_VERSION_1_2,
  606. GL_VERSION_1_3,
  607. GL_VERSION_1_4,
  608. GL_VERSION_2_0,
  609. GL_VERSION_3_3,
  610. GL_SGIS_generate_mipmap,
  611. GL_ARB_texture_border_clamp,
  612. GL_ARB_texture_mirrored_repeat,
  613. GL_ARB_texture_rectangle,
  614. GL_ARB_texture_non_power_of_two,
  615. GL_ARB_texture_swizzle,
  616. GL_ARB_texture_cube_map,
  617. GL_IBM_texture_mirrored_repeat,
  618. GL_NV_texture_rectangle,
  619. GL_EXT_texture_edge_clamp,
  620. GL_EXT_texture_rectangle,
  621. GL_EXT_texture_swizzle,
  622. GL_EXT_texture_cube_map,
  623. GL_EXT_texture_filter_anisotropic: Boolean;
  624. glCompressedTexImage1D: TglCompressedTexImage1D;
  625. glCompressedTexImage2D: TglCompressedTexImage2D;
  626. glGetCompressedTexImage: TglGetCompressedTexImage;
  627. {$IF DEFINED(GLB_WIN)}
  628. wglGetProcAddress: TwglGetProcAddress;
  629. {$ELSEIF DEFINED(GLB_LINUX)}
  630. glXGetProcAddress: TglXGetProcAddress;
  631. glXGetProcAddressARB: TglXGetProcAddress;
  632. {$IFEND}
  633. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  634. glEnable: TglEnable;
  635. glDisable: TglDisable;
  636. glGetString: TglGetString;
  637. glGetIntegerv: TglGetIntegerv;
  638. glTexParameteri: TglTexParameteri;
  639. glTexParameteriv: TglTexParameteriv;
  640. glTexParameterfv: TglTexParameterfv;
  641. glGetTexParameteriv: TglGetTexParameteriv;
  642. glGetTexParameterfv: TglGetTexParameterfv;
  643. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  644. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  645. glTexGeni: TglTexGeni;
  646. glGenTextures: TglGenTextures;
  647. glBindTexture: TglBindTexture;
  648. glDeleteTextures: TglDeleteTextures;
  649. glAreTexturesResident: TglAreTexturesResident;
  650. glReadPixels: TglReadPixels;
  651. glPixelStorei: TglPixelStorei;
  652. glTexImage1D: TglTexImage1D;
  653. glTexImage2D: TglTexImage2D;
  654. glGetTexImage: TglGetTexImage;
  655. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  656. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  657. {$ENDIF}
  658. {$ENDIF}
  659. type
  660. ////////////////////////////////////////////////////////////////////////////////////////////////////
  661. TglBitmapFormat = (
  662. tfEmpty = 0, //must be smallest value!
  663. tfAlpha4,
  664. tfAlpha8,
  665. tfAlpha12,
  666. tfAlpha16,
  667. tfLuminance4,
  668. tfLuminance8,
  669. tfLuminance12,
  670. tfLuminance16,
  671. tfLuminance4Alpha4,
  672. tfLuminance6Alpha2,
  673. tfLuminance8Alpha8,
  674. tfLuminance12Alpha4,
  675. tfLuminance12Alpha12,
  676. tfLuminance16Alpha16,
  677. tfR3G3B2,
  678. tfRGB4,
  679. tfR5G6B5,
  680. tfRGB5,
  681. tfRGB8,
  682. tfRGB10,
  683. tfRGB12,
  684. tfRGB16,
  685. tfRGBA2,
  686. tfRGBA4,
  687. tfRGB5A1,
  688. tfRGBA8,
  689. tfRGB10A2,
  690. tfRGBA12,
  691. tfRGBA16,
  692. tfBGR4,
  693. tfB5G6R5,
  694. tfBGR5,
  695. tfBGR8,
  696. tfBGR10,
  697. tfBGR12,
  698. tfBGR16,
  699. tfBGRA2,
  700. tfBGRA4,
  701. tfBGR5A1,
  702. tfBGRA8,
  703. tfBGR10A2,
  704. tfBGRA12,
  705. tfBGRA16,
  706. tfDepth16,
  707. tfDepth24,
  708. tfDepth32,
  709. tfS3tcDtx1RGBA,
  710. tfS3tcDtx3RGBA,
  711. tfS3tcDtx5RGBA
  712. );
  713. TglBitmapFileType = (
  714. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  715. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  716. ftDDS,
  717. ftTGA,
  718. ftBMP);
  719. TglBitmapFileTypes = set of TglBitmapFileType;
  720. TglBitmapMipMap = (
  721. mmNone,
  722. mmMipmap,
  723. mmMipmapGlu);
  724. TglBitmapNormalMapFunc = (
  725. nm4Samples,
  726. nmSobel,
  727. nm3x3,
  728. nm5x5);
  729. ////////////////////////////////////////////////////////////////////////////////////////////////////
  730. EglBitmap = class(Exception);
  731. EglBitmapNotSupported = class(Exception);
  732. EglBitmapSizeToLarge = class(EglBitmap);
  733. EglBitmapNonPowerOfTwo = class(EglBitmap);
  734. EglBitmapUnsupportedFormat = class(EglBitmap)
  735. public
  736. constructor Create(const aFormat: TglBitmapFormat); overload;
  737. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  738. end;
  739. ////////////////////////////////////////////////////////////////////////////////////////////////////
  740. TglBitmapColorRec = packed record
  741. case Integer of
  742. 0: (r, g, b, a: Cardinal);
  743. 1: (arr: array[0..3] of Cardinal);
  744. end;
  745. TglBitmapPixelData = packed record
  746. Data, Range: TglBitmapColorRec;
  747. Format: TglBitmapFormat;
  748. end;
  749. PglBitmapPixelData = ^TglBitmapPixelData;
  750. ////////////////////////////////////////////////////////////////////////////////////////////////////
  751. TglBitmapPixelPositionFields = set of (ffX, ffY);
  752. TglBitmapPixelPosition = record
  753. Fields : TglBitmapPixelPositionFields;
  754. X : Word;
  755. Y : Word;
  756. end;
  757. TglBitmapFormatDescriptor = class(TObject)
  758. protected
  759. function GetIsCompressed: Boolean; virtual; abstract;
  760. function GetHasRed: Boolean; virtual; abstract;
  761. function GetHasGreen: Boolean; virtual; abstract;
  762. function GetHasBlue: Boolean; virtual; abstract;
  763. function GetHasAlpha: Boolean; virtual; abstract;
  764. function GetglDataFormat: GLenum; virtual; abstract;
  765. function GetglFormat: GLenum; virtual; abstract;
  766. function GetglInternalFormat: GLenum; virtual; abstract;
  767. public
  768. property IsCompressed: Boolean read GetIsCompressed;
  769. property HasRed: Boolean read GetHasRed;
  770. property HasGreen: Boolean read GetHasGreen;
  771. property HasBlue: Boolean read GetHasBlue;
  772. property HasAlpha: Boolean read GetHasAlpha;
  773. property glFormat: GLenum read GetglFormat;
  774. property glInternalFormat: GLenum read GetglInternalFormat;
  775. property glDataFormat: GLenum read GetglDataFormat;
  776. end;
  777. ////////////////////////////////////////////////////////////////////////////////////////////////////
  778. TglBitmap = class;
  779. TglBitmapFunctionRec = record
  780. Sender: TglBitmap;
  781. Size: TglBitmapPixelPosition;
  782. Position: TglBitmapPixelPosition;
  783. Source: TglBitmapPixelData;
  784. Dest: TglBitmapPixelData;
  785. Args: Pointer;
  786. end;
  787. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  788. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  789. TglBitmap = class
  790. private
  791. function GetFormatDesc: TglBitmapFormatDescriptor;
  792. protected
  793. fID: GLuint;
  794. fTarget: GLuint;
  795. fAnisotropic: Integer;
  796. fDeleteTextureOnFree: Boolean;
  797. fFreeDataOnDestroy: Boolean;
  798. fFreeDataAfterGenTexture: Boolean;
  799. fData: PByte;
  800. fIsResident: GLboolean;
  801. fBorderColor: array[0..3] of Single;
  802. fDimension: TglBitmapPixelPosition;
  803. fMipMap: TglBitmapMipMap;
  804. fFormat: TglBitmapFormat;
  805. // Mapping
  806. fPixelSize: Integer;
  807. fRowSize: Integer;
  808. // Filtering
  809. fFilterMin: GLenum;
  810. fFilterMag: GLenum;
  811. // TexturWarp
  812. fWrapS: GLenum;
  813. fWrapT: GLenum;
  814. fWrapR: GLenum;
  815. //Swizzle
  816. fSwizzle: array[0..3] of GLenum;
  817. // CustomData
  818. fFilename: String;
  819. fCustomName: String;
  820. fCustomNameW: WideString;
  821. fCustomData: Pointer;
  822. //Getter
  823. function GetWidth: Integer; virtual;
  824. function GetHeight: Integer; virtual;
  825. function GetFileWidth: Integer; virtual;
  826. function GetFileHeight: Integer; virtual;
  827. //Setter
  828. procedure SetCustomData(const aValue: Pointer);
  829. procedure SetCustomName(const aValue: String);
  830. procedure SetCustomNameW(const aValue: WideString);
  831. procedure SetFreeDataOnDestroy(const aValue: Boolean);
  832. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  833. procedure SetFormat(const aValue: TglBitmapFormat);
  834. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  835. procedure SetID(const aValue: Cardinal);
  836. procedure SetMipMap(const aValue: TglBitmapMipMap);
  837. procedure SetTarget(const aValue: Cardinal);
  838. procedure SetAnisotropic(const aValue: Integer);
  839. procedure CreateID;
  840. procedure SetupParameters(out aBuildWithGlu: Boolean);
  841. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  842. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method
  843. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  844. function FlipHorz: Boolean; virtual;
  845. function FlipVert: Boolean; virtual;
  846. property Width: Integer read GetWidth;
  847. property Height: Integer read GetHeight;
  848. property FileWidth: Integer read GetFileWidth;
  849. property FileHeight: Integer read GetFileHeight;
  850. public
  851. //Properties
  852. property ID: Cardinal read fID write SetID;
  853. property Target: Cardinal read fTarget write SetTarget;
  854. property Format: TglBitmapFormat read fFormat write SetFormat;
  855. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  856. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  857. property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc;
  858. property Filename: String read fFilename;
  859. property CustomName: String read fCustomName write SetCustomName;
  860. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  861. property CustomData: Pointer read fCustomData write SetCustomData;
  862. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  863. property FreeDataOnDestroy: Boolean read fFreeDataOnDestroy write SetFreeDataOnDestroy;
  864. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  865. property Dimension: TglBitmapPixelPosition read fDimension;
  866. property Data: PByte read fData;
  867. property IsResident: GLboolean read fIsResident;
  868. procedure AfterConstruction; override;
  869. procedure BeforeDestruction; override;
  870. procedure PrepareResType(var aResource: String; var aResType: PChar);
  871. //Load
  872. procedure LoadFromFile(const aFilename: String);
  873. procedure LoadFromStream(const aStream: TStream); virtual;
  874. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  875. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  876. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  877. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  878. //Save
  879. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  880. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  881. //Convert
  882. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  883. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  884. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  885. public
  886. //Alpha & Co
  887. {$IFDEF GLB_SDL}
  888. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  889. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  890. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  891. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  892. const aArgs: Pointer = nil): Boolean;
  893. {$ENDIF}
  894. {$IFDEF GLB_DELPHI}
  895. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  896. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  897. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  898. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  899. const aArgs: Pointer = nil): Boolean;
  900. {$ENDIF}
  901. {$IFDEF GLB_LAZARUS}
  902. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  903. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  904. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  905. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  906. const aArgs: Pointer = nil): Boolean;
  907. {$ENDIF}
  908. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  909. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  910. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  911. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  912. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  913. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  914. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  915. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  916. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  917. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  918. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  919. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  920. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  921. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  922. function RemoveAlpha: Boolean; virtual;
  923. public
  924. //Common
  925. function Clone: TglBitmap;
  926. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  927. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  928. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  929. procedure FreeData;
  930. //ColorFill
  931. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  932. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  933. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  934. //TexParameters
  935. procedure SetFilter(const aMin, aMag: GLenum);
  936. procedure SetWrap(
  937. const S: GLenum = GL_CLAMP_TO_EDGE;
  938. const T: GLenum = GL_CLAMP_TO_EDGE;
  939. const R: GLenum = GL_CLAMP_TO_EDGE);
  940. procedure SetSwizzle(const r, g, b, a: GLenum);
  941. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  942. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  943. //Constructors
  944. constructor Create; overload;
  945. constructor Create(const aFileName: String); overload;
  946. constructor Create(const aStream: TStream); overload;
  947. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  948. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  949. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  950. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  951. private
  952. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  953. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  954. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  955. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  956. function LoadBMP(const aStream: TStream): Boolean; virtual;
  957. procedure SaveBMP(const aStream: TStream); virtual;
  958. function LoadTGA(const aStream: TStream): Boolean; virtual;
  959. procedure SaveTGA(const aStream: TStream); virtual;
  960. function LoadDDS(const aStream: TStream): Boolean; virtual;
  961. procedure SaveDDS(const aStream: TStream); virtual;
  962. end;
  963. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  964. TglBitmap1D = class(TglBitmap)
  965. protected
  966. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  967. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  968. procedure UploadData(const aBuildWithGlu: Boolean);
  969. public
  970. property Width;
  971. procedure AfterConstruction; override;
  972. function FlipHorz: Boolean; override;
  973. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  974. end;
  975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  976. TglBitmap2D = class(TglBitmap)
  977. protected
  978. fLines: array of PByte;
  979. function GetScanline(const aIndex: Integer): Pointer;
  980. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  981. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  982. procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  983. public
  984. property Width;
  985. property Height;
  986. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  987. procedure AfterConstruction; override;
  988. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  989. procedure GetDataFromTexture;
  990. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  991. function FlipHorz: Boolean; override;
  992. function FlipVert: Boolean; override;
  993. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  994. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  995. end;
  996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  997. TglBitmapCubeMap = class(TglBitmap2D)
  998. protected
  999. fGenMode: Integer;
  1000. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  1001. public
  1002. procedure AfterConstruction; override;
  1003. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  1004. procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  1005. procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  1006. end;
  1007. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1008. TglBitmapNormalMap = class(TglBitmapCubeMap)
  1009. public
  1010. procedure AfterConstruction; override;
  1011. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  1012. end;
  1013. const
  1014. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1015. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1016. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1017. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1018. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1019. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1020. procedure glBitmapSetDefaultWrap(
  1021. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1022. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1023. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1024. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1025. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1026. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1027. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1028. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1029. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1030. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1031. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1032. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1033. var
  1034. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1035. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1036. glBitmapDefaultFormat: TglBitmapFormat;
  1037. glBitmapDefaultMipmap: TglBitmapMipMap;
  1038. glBitmapDefaultFilterMin: Cardinal;
  1039. glBitmapDefaultFilterMag: Cardinal;
  1040. glBitmapDefaultWrapS: Cardinal;
  1041. glBitmapDefaultWrapT: Cardinal;
  1042. glBitmapDefaultWrapR: Cardinal;
  1043. glDefaultSwizzle: array[0..3] of GLenum;
  1044. {$IFDEF GLB_DELPHI}
  1045. function CreateGrayPalette: HPALETTE;
  1046. {$ENDIF}
  1047. implementation
  1048. uses
  1049. Math, syncobjs, typinfo
  1050. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1051. type
  1052. {$IFNDEF fpc}
  1053. QWord = System.UInt64;
  1054. PQWord = ^QWord;
  1055. PtrInt = Longint;
  1056. PtrUInt = DWord;
  1057. {$ENDIF}
  1058. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1059. TShiftRec = packed record
  1060. case Integer of
  1061. 0: (r, g, b, a: Byte);
  1062. 1: (arr: array[0..3] of Byte);
  1063. end;
  1064. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1065. private
  1066. function GetRedMask: QWord;
  1067. function GetGreenMask: QWord;
  1068. function GetBlueMask: QWord;
  1069. function GetAlphaMask: QWord;
  1070. protected
  1071. fFormat: TglBitmapFormat;
  1072. fWithAlpha: TglBitmapFormat;
  1073. fWithoutAlpha: TglBitmapFormat;
  1074. fRGBInverted: TglBitmapFormat;
  1075. fUncompressed: TglBitmapFormat;
  1076. fPixelSize: Single;
  1077. fIsCompressed: Boolean;
  1078. fRange: TglBitmapColorRec;
  1079. fShift: TShiftRec;
  1080. fglFormat: GLenum;
  1081. fglInternalFormat: GLenum;
  1082. fglDataFormat: GLenum;
  1083. function GetIsCompressed: Boolean; override;
  1084. function GetHasRed: Boolean; override;
  1085. function GetHasGreen: Boolean; override;
  1086. function GetHasBlue: Boolean; override;
  1087. function GetHasAlpha: Boolean; override;
  1088. function GetglFormat: GLenum; override;
  1089. function GetglInternalFormat: GLenum; override;
  1090. function GetglDataFormat: GLenum; override;
  1091. function GetComponents: Integer; virtual;
  1092. public
  1093. property Format: TglBitmapFormat read fFormat;
  1094. property WithAlpha: TglBitmapFormat read fWithAlpha;
  1095. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  1096. property RGBInverted: TglBitmapFormat read fRGBInverted;
  1097. property Components: Integer read GetComponents;
  1098. property PixelSize: Single read fPixelSize;
  1099. property Range: TglBitmapColorRec read fRange;
  1100. property Shift: TShiftRec read fShift;
  1101. property RedMask: QWord read GetRedMask;
  1102. property GreenMask: QWord read GetGreenMask;
  1103. property BlueMask: QWord read GetBlueMask;
  1104. property AlphaMask: QWord read GetAlphaMask;
  1105. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1106. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1107. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1108. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1109. function CreateMappingData: Pointer; virtual;
  1110. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1111. function IsEmpty: Boolean; virtual;
  1112. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  1113. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1114. constructor Create; virtual;
  1115. public
  1116. class procedure Init;
  1117. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1118. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1119. class procedure Clear;
  1120. class procedure Finalize;
  1121. end;
  1122. TFormatDescriptorClass = class of TFormatDescriptor;
  1123. TfdEmpty = class(TFormatDescriptor);
  1124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1125. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1126. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1127. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1128. constructor Create; override;
  1129. end;
  1130. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1131. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1132. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1133. constructor Create; override;
  1134. end;
  1135. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1136. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1137. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1138. constructor Create; override;
  1139. end;
  1140. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1141. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1142. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1143. constructor Create; override;
  1144. end;
  1145. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1146. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1147. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1148. constructor Create; override;
  1149. end;
  1150. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1151. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1152. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1153. constructor Create; override;
  1154. end;
  1155. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1156. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1157. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1158. constructor Create; override;
  1159. end;
  1160. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1161. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1162. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1163. constructor Create; override;
  1164. end;
  1165. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1166. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  1167. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1168. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1169. constructor Create; override;
  1170. end;
  1171. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  1172. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1173. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1174. constructor Create; override;
  1175. end;
  1176. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1177. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1178. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1179. constructor Create; override;
  1180. end;
  1181. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1182. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1183. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1184. constructor Create; override;
  1185. end;
  1186. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1187. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1188. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1189. constructor Create; override;
  1190. end;
  1191. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1192. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1193. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1194. constructor Create; override;
  1195. end;
  1196. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1197. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1198. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1199. constructor Create; override;
  1200. end;
  1201. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1202. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1203. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1204. constructor Create; override;
  1205. end;
  1206. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1207. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1208. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1209. constructor Create; override;
  1210. end;
  1211. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1212. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  1213. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1214. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1215. constructor Create; override;
  1216. end;
  1217. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1218. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1219. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1220. constructor Create; override;
  1221. end;
  1222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1223. TfdAlpha4 = class(TfdAlpha_UB1)
  1224. constructor Create; override;
  1225. end;
  1226. TfdAlpha8 = class(TfdAlpha_UB1)
  1227. constructor Create; override;
  1228. end;
  1229. TfdAlpha12 = class(TfdAlpha_US1)
  1230. constructor Create; override;
  1231. end;
  1232. TfdAlpha16 = class(TfdAlpha_US1)
  1233. constructor Create; override;
  1234. end;
  1235. TfdLuminance4 = class(TfdLuminance_UB1)
  1236. constructor Create; override;
  1237. end;
  1238. TfdLuminance8 = class(TfdLuminance_UB1)
  1239. constructor Create; override;
  1240. end;
  1241. TfdLuminance12 = class(TfdLuminance_US1)
  1242. constructor Create; override;
  1243. end;
  1244. TfdLuminance16 = class(TfdLuminance_US1)
  1245. constructor Create; override;
  1246. end;
  1247. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1248. constructor Create; override;
  1249. end;
  1250. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1251. constructor Create; override;
  1252. end;
  1253. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1254. constructor Create; override;
  1255. end;
  1256. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1257. constructor Create; override;
  1258. end;
  1259. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1260. constructor Create; override;
  1261. end;
  1262. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1263. constructor Create; override;
  1264. end;
  1265. TfdR3G3B2 = class(TfdUniversal_UB1)
  1266. constructor Create; override;
  1267. end;
  1268. TfdRGB4 = class(TfdUniversal_US1)
  1269. constructor Create; override;
  1270. end;
  1271. TfdR5G6B5 = class(TfdUniversal_US1)
  1272. constructor Create; override;
  1273. end;
  1274. TfdRGB5 = class(TfdUniversal_US1)
  1275. constructor Create; override;
  1276. end;
  1277. TfdRGB8 = class(TfdRGB_UB3)
  1278. constructor Create; override;
  1279. end;
  1280. TfdRGB10 = class(TfdUniversal_UI1)
  1281. constructor Create; override;
  1282. end;
  1283. TfdRGB12 = class(TfdRGB_US3)
  1284. constructor Create; override;
  1285. end;
  1286. TfdRGB16 = class(TfdRGB_US3)
  1287. constructor Create; override;
  1288. end;
  1289. TfdRGBA2 = class(TfdRGBA_UB4)
  1290. constructor Create; override;
  1291. end;
  1292. TfdRGBA4 = class(TfdUniversal_US1)
  1293. constructor Create; override;
  1294. end;
  1295. TfdRGB5A1 = class(TfdUniversal_US1)
  1296. constructor Create; override;
  1297. end;
  1298. TfdRGBA8 = class(TfdRGBA_UB4)
  1299. constructor Create; override;
  1300. end;
  1301. TfdRGB10A2 = class(TfdUniversal_UI1)
  1302. constructor Create; override;
  1303. end;
  1304. TfdRGBA12 = class(TfdRGBA_US4)
  1305. constructor Create; override;
  1306. end;
  1307. TfdRGBA16 = class(TfdRGBA_US4)
  1308. constructor Create; override;
  1309. end;
  1310. TfdBGR4 = class(TfdUniversal_US1)
  1311. constructor Create; override;
  1312. end;
  1313. TfdB5G6R5 = class(TfdUniversal_US1)
  1314. constructor Create; override;
  1315. end;
  1316. TfdBGR5 = class(TfdUniversal_US1)
  1317. constructor Create; override;
  1318. end;
  1319. TfdBGR8 = class(TfdBGR_UB3)
  1320. constructor Create; override;
  1321. end;
  1322. TfdBGR10 = class(TfdUniversal_UI1)
  1323. constructor Create; override;
  1324. end;
  1325. TfdBGR12 = class(TfdBGR_US3)
  1326. constructor Create; override;
  1327. end;
  1328. TfdBGR16 = class(TfdBGR_US3)
  1329. constructor Create; override;
  1330. end;
  1331. TfdBGRA2 = class(TfdBGRA_UB4)
  1332. constructor Create; override;
  1333. end;
  1334. TfdBGRA4 = class(TfdUniversal_US1)
  1335. constructor Create; override;
  1336. end;
  1337. TfdBGR5A1 = class(TfdUniversal_US1)
  1338. constructor Create; override;
  1339. end;
  1340. TfdBGRA8 = class(TfdBGRA_UB4)
  1341. constructor Create; override;
  1342. end;
  1343. TfdBGR10A2 = class(TfdUniversal_UI1)
  1344. constructor Create; override;
  1345. end;
  1346. TfdBGRA12 = class(TfdBGRA_US4)
  1347. constructor Create; override;
  1348. end;
  1349. TfdBGRA16 = class(TfdBGRA_US4)
  1350. constructor Create; override;
  1351. end;
  1352. TfdDepth16 = class(TfdDepth_US1)
  1353. constructor Create; override;
  1354. end;
  1355. TfdDepth24 = class(TfdDepth_UI1)
  1356. constructor Create; override;
  1357. end;
  1358. TfdDepth32 = class(TfdDepth_UI1)
  1359. constructor Create; override;
  1360. end;
  1361. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1362. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1363. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1364. constructor Create; override;
  1365. end;
  1366. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1367. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1368. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1369. constructor Create; override;
  1370. end;
  1371. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1372. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1373. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1374. constructor Create; override;
  1375. end;
  1376. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1377. TbmpBitfieldFormat = class(TFormatDescriptor)
  1378. private
  1379. procedure SetRedMask (const aValue: QWord);
  1380. procedure SetGreenMask(const aValue: QWord);
  1381. procedure SetBlueMask (const aValue: QWord);
  1382. procedure SetAlphaMask(const aValue: QWord);
  1383. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1384. public
  1385. property RedMask: QWord read GetRedMask write SetRedMask;
  1386. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1387. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1388. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1389. property PixelSize: Single read fPixelSize write fPixelSize;
  1390. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1391. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1392. end;
  1393. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1394. TbmpColorTableEnty = packed record
  1395. b, g, r, a: Byte;
  1396. end;
  1397. TbmpColorTable = array of TbmpColorTableEnty;
  1398. TbmpColorTableFormat = class(TFormatDescriptor)
  1399. private
  1400. fColorTable: TbmpColorTable;
  1401. public
  1402. property PixelSize: Single read fPixelSize write fPixelSize;
  1403. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1404. property Range: TglBitmapColorRec read fRange write fRange;
  1405. property Shift: TShiftRec read fShift write fShift;
  1406. property Format: TglBitmapFormat read fFormat write fFormat;
  1407. procedure CreateColorTable;
  1408. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1409. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1410. destructor Destroy; override;
  1411. end;
  1412. const
  1413. LUMINANCE_WEIGHT_R = 0.30;
  1414. LUMINANCE_WEIGHT_G = 0.59;
  1415. LUMINANCE_WEIGHT_B = 0.11;
  1416. ALPHA_WEIGHT_R = 0.30;
  1417. ALPHA_WEIGHT_G = 0.59;
  1418. ALPHA_WEIGHT_B = 0.11;
  1419. DEPTH_WEIGHT_R = 0.333333333;
  1420. DEPTH_WEIGHT_G = 0.333333333;
  1421. DEPTH_WEIGHT_B = 0.333333333;
  1422. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1423. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1424. TfdEmpty,
  1425. TfdAlpha4,
  1426. TfdAlpha8,
  1427. TfdAlpha12,
  1428. TfdAlpha16,
  1429. TfdLuminance4,
  1430. TfdLuminance8,
  1431. TfdLuminance12,
  1432. TfdLuminance16,
  1433. TfdLuminance4Alpha4,
  1434. TfdLuminance6Alpha2,
  1435. TfdLuminance8Alpha8,
  1436. TfdLuminance12Alpha4,
  1437. TfdLuminance12Alpha12,
  1438. TfdLuminance16Alpha16,
  1439. TfdR3G3B2,
  1440. TfdRGB4,
  1441. TfdR5G6B5,
  1442. TfdRGB5,
  1443. TfdRGB8,
  1444. TfdRGB10,
  1445. TfdRGB12,
  1446. TfdRGB16,
  1447. TfdRGBA2,
  1448. TfdRGBA4,
  1449. TfdRGB5A1,
  1450. TfdRGBA8,
  1451. TfdRGB10A2,
  1452. TfdRGBA12,
  1453. TfdRGBA16,
  1454. TfdBGR4,
  1455. TfdB5G6R5,
  1456. TfdBGR5,
  1457. TfdBGR8,
  1458. TfdBGR10,
  1459. TfdBGR12,
  1460. TfdBGR16,
  1461. TfdBGRA2,
  1462. TfdBGRA4,
  1463. TfdBGR5A1,
  1464. TfdBGRA8,
  1465. TfdBGR10A2,
  1466. TfdBGRA12,
  1467. TfdBGRA16,
  1468. TfdDepth16,
  1469. TfdDepth24,
  1470. TfdDepth32,
  1471. TfdS3tcDtx1RGBA,
  1472. TfdS3tcDtx3RGBA,
  1473. TfdS3tcDtx5RGBA
  1474. );
  1475. var
  1476. FormatDescriptorCS: TCriticalSection;
  1477. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1478. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1479. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1480. begin
  1481. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1482. end;
  1483. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1484. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1485. begin
  1486. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1487. end;
  1488. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1489. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1490. begin
  1491. result.Fields := [];
  1492. if X >= 0 then
  1493. result.Fields := result.Fields + [ffX];
  1494. if Y >= 0 then
  1495. result.Fields := result.Fields + [ffY];
  1496. result.X := Max(0, X);
  1497. result.Y := Max(0, Y);
  1498. end;
  1499. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1500. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1501. begin
  1502. result.r := r;
  1503. result.g := g;
  1504. result.b := b;
  1505. result.a := a;
  1506. end;
  1507. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1508. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1509. var
  1510. i: Integer;
  1511. begin
  1512. result := false;
  1513. for i := 0 to high(r1.arr) do
  1514. if (r1.arr[i] <> r2.arr[i]) then
  1515. exit;
  1516. result := true;
  1517. end;
  1518. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1519. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1520. begin
  1521. result.r := r;
  1522. result.g := g;
  1523. result.b := b;
  1524. result.a := a;
  1525. end;
  1526. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1527. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1528. begin
  1529. result := [];
  1530. if (aFormat in [
  1531. //4 bbp
  1532. tfLuminance4,
  1533. //8bpp
  1534. tfR3G3B2, tfLuminance8,
  1535. //16bpp
  1536. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1537. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1538. //24bpp
  1539. tfBGR8, tfRGB8,
  1540. //32bpp
  1541. tfRGB10, tfRGB10A2, tfRGBA8,
  1542. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1543. result := result + [ftBMP];
  1544. if (aFormat in [
  1545. //8 bpp
  1546. tfLuminance8, tfAlpha8,
  1547. //16 bpp
  1548. tfLuminance16, tfLuminance8Alpha8,
  1549. tfRGB5, tfRGB5A1, tfRGBA4,
  1550. tfBGR5, tfBGR5A1, tfBGRA4,
  1551. //24 bpp
  1552. tfRGB8, tfBGR8,
  1553. //32 bpp
  1554. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1555. result := result + [ftTGA];
  1556. if (aFormat in [
  1557. //8 bpp
  1558. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1559. tfR3G3B2, tfRGBA2, tfBGRA2,
  1560. //16 bpp
  1561. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1562. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1563. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1564. //24 bpp
  1565. tfRGB8, tfBGR8,
  1566. //32 bbp
  1567. tfLuminance16Alpha16,
  1568. tfRGBA8, tfRGB10A2,
  1569. tfBGRA8, tfBGR10A2,
  1570. //compressed
  1571. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1572. result := result + [ftDDS];
  1573. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1574. if aFormat in [
  1575. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1576. tfRGB8, tfRGBA8,
  1577. tfBGR8, tfBGRA8] then
  1578. result := result + [ftPNG];
  1579. {$ENDIF}
  1580. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1581. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1582. result := result + [ftJPEG];
  1583. {$ENDIF}
  1584. end;
  1585. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1586. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1587. begin
  1588. while (aNumber and 1) = 0 do
  1589. aNumber := aNumber shr 1;
  1590. result := aNumber = 1;
  1591. end;
  1592. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1593. function GetTopMostBit(aBitSet: QWord): Integer;
  1594. begin
  1595. result := 0;
  1596. while aBitSet > 0 do begin
  1597. inc(result);
  1598. aBitSet := aBitSet shr 1;
  1599. end;
  1600. end;
  1601. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1602. function CountSetBits(aBitSet: QWord): Integer;
  1603. begin
  1604. result := 0;
  1605. while aBitSet > 0 do begin
  1606. if (aBitSet and 1) = 1 then
  1607. inc(result);
  1608. aBitSet := aBitSet shr 1;
  1609. end;
  1610. end;
  1611. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1612. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1613. begin
  1614. result := Trunc(
  1615. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1616. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1617. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1618. end;
  1619. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1620. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1621. begin
  1622. result := Trunc(
  1623. DEPTH_WEIGHT_R * aPixel.Data.r +
  1624. DEPTH_WEIGHT_G * aPixel.Data.g +
  1625. DEPTH_WEIGHT_B * aPixel.Data.b);
  1626. end;
  1627. {$IFDEF GLB_NATIVE_OGL}
  1628. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1629. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1630. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1631. var
  1632. GL_LibHandle: Pointer = nil;
  1633. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
  1634. begin
  1635. if not Assigned(aLibHandle) then
  1636. aLibHandle := GL_LibHandle;
  1637. {$IF DEFINED(GLB_WIN)}
  1638. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1639. if Assigned(result) then
  1640. exit;
  1641. if Assigned(wglGetProcAddress) then
  1642. result := wglGetProcAddress(aProcName);
  1643. {$ELSEIF DEFINED(GLB_LINUX)}
  1644. if Assigned(glXGetProcAddress) then begin
  1645. result := glXGetProcAddress(aProcName);
  1646. if Assigned(result) then
  1647. exit;
  1648. end;
  1649. if Assigned(glXGetProcAddressARB) then begin
  1650. result := glXGetProcAddressARB(aProcName);
  1651. if Assigned(result) then
  1652. exit;
  1653. end;
  1654. result := dlsym(aLibHandle, aProcName);
  1655. {$IFEND}
  1656. if not Assigned(result) and aRaiseOnErr then
  1657. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1658. end;
  1659. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1660. var
  1661. GLU_LibHandle: Pointer = nil;
  1662. OpenGLInitialized: Boolean;
  1663. InitOpenGLCS: TCriticalSection;
  1664. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1665. procedure glbInitOpenGL;
  1666. ////////////////////////////////////////////////////////////////////////////////
  1667. function glbLoadLibrary(const aName: PChar): Pointer;
  1668. begin
  1669. {$IF DEFINED(GLB_WIN)}
  1670. result := {%H-}Pointer(LoadLibrary(aName));
  1671. {$ELSEIF DEFINED(GLB_LINUX)}
  1672. result := dlopen(Name, RTLD_LAZY);
  1673. {$ELSE}
  1674. result := nil;
  1675. {$IFEND}
  1676. end;
  1677. ////////////////////////////////////////////////////////////////////////////////
  1678. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1679. begin
  1680. result := false;
  1681. if not Assigned(aLibHandle) then
  1682. exit;
  1683. {$IF DEFINED(GLB_WIN)}
  1684. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1685. {$ELSEIF DEFINED(GLB_LINUX)}
  1686. Result := dlclose(aLibHandle) = 0;
  1687. {$IFEND}
  1688. end;
  1689. begin
  1690. if Assigned(GL_LibHandle) then
  1691. glbFreeLibrary(GL_LibHandle);
  1692. if Assigned(GLU_LibHandle) then
  1693. glbFreeLibrary(GLU_LibHandle);
  1694. GL_LibHandle := glbLoadLibrary(libopengl);
  1695. if not Assigned(GL_LibHandle) then
  1696. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1697. GLU_LibHandle := glbLoadLibrary(libglu);
  1698. if not Assigned(GLU_LibHandle) then
  1699. raise EglBitmap.Create('unable to load library: ' + libglu);
  1700. {$IF DEFINED(GLB_WIN)}
  1701. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1702. {$ELSEIF DEFINED(GLB_LINUX)}
  1703. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1704. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1705. {$IFEND}
  1706. glEnable := glbGetProcAddress('glEnable');
  1707. glDisable := glbGetProcAddress('glDisable');
  1708. glGetString := glbGetProcAddress('glGetString');
  1709. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1710. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1711. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1712. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1713. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1714. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1715. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1716. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1717. glTexGeni := glbGetProcAddress('glTexGeni');
  1718. glGenTextures := glbGetProcAddress('glGenTextures');
  1719. glBindTexture := glbGetProcAddress('glBindTexture');
  1720. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1721. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1722. glReadPixels := glbGetProcAddress('glReadPixels');
  1723. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1724. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1725. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1726. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1727. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1728. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1729. end;
  1730. {$ENDIF}
  1731. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1732. procedure glbReadOpenGLExtensions;
  1733. var
  1734. Buffer: AnsiString;
  1735. MajorVersion, MinorVersion: Integer;
  1736. ///////////////////////////////////////////////////////////////////////////////////////////
  1737. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1738. var
  1739. Separator: Integer;
  1740. begin
  1741. aMinor := 0;
  1742. aMajor := 0;
  1743. Separator := Pos(AnsiString('.'), aBuffer);
  1744. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1745. (aBuffer[Separator - 1] in ['0'..'9']) and
  1746. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1747. Dec(Separator);
  1748. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1749. Dec(Separator);
  1750. Delete(aBuffer, 1, Separator);
  1751. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1752. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1753. Inc(Separator);
  1754. Delete(aBuffer, Separator, 255);
  1755. Separator := Pos(AnsiString('.'), aBuffer);
  1756. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1757. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1758. end;
  1759. end;
  1760. ///////////////////////////////////////////////////////////////////////////////////////////
  1761. function CheckExtension(const Extension: AnsiString): Boolean;
  1762. var
  1763. ExtPos: Integer;
  1764. begin
  1765. ExtPos := Pos(Extension, Buffer);
  1766. result := ExtPos > 0;
  1767. if result then
  1768. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1769. end;
  1770. ///////////////////////////////////////////////////////////////////////////////////////////
  1771. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1772. begin
  1773. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1774. end;
  1775. begin
  1776. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1777. InitOpenGLCS.Enter;
  1778. try
  1779. if not OpenGLInitialized then begin
  1780. glbInitOpenGL;
  1781. OpenGLInitialized := true;
  1782. end;
  1783. finally
  1784. InitOpenGLCS.Leave;
  1785. end;
  1786. {$ENDIF}
  1787. // Version
  1788. Buffer := glGetString(GL_VERSION);
  1789. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1790. GL_VERSION_1_2 := CheckVersion(1, 2);
  1791. GL_VERSION_1_3 := CheckVersion(1, 3);
  1792. GL_VERSION_1_4 := CheckVersion(1, 4);
  1793. GL_VERSION_2_0 := CheckVersion(2, 0);
  1794. GL_VERSION_3_3 := CheckVersion(3, 3);
  1795. // Extensions
  1796. Buffer := glGetString(GL_EXTENSIONS);
  1797. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1798. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1799. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1800. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1801. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1802. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1803. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1804. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1805. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1806. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1807. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1808. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1809. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1810. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1811. if GL_VERSION_1_3 then begin
  1812. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1813. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1814. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1815. end else begin
  1816. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false);
  1817. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false);
  1818. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
  1819. end;
  1820. end;
  1821. {$ENDIF}
  1822. {$IFDEF GLB_SDL_IMAGE}
  1823. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1824. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1825. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1826. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1827. begin
  1828. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1829. end;
  1830. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1831. begin
  1832. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1833. end;
  1834. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1835. begin
  1836. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1837. end;
  1838. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1839. begin
  1840. result := 0;
  1841. end;
  1842. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1843. begin
  1844. result := SDL_AllocRW;
  1845. if result = nil then
  1846. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1847. result^.seek := glBitmapRWseek;
  1848. result^.read := glBitmapRWread;
  1849. result^.write := glBitmapRWwrite;
  1850. result^.close := glBitmapRWclose;
  1851. result^.unknown.data1 := Stream;
  1852. end;
  1853. {$ENDIF}
  1854. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1855. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1856. begin
  1857. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1858. end;
  1859. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1860. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1861. begin
  1862. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1863. end;
  1864. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1865. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1866. begin
  1867. glBitmapDefaultMipmap := aValue;
  1868. end;
  1869. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1870. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1871. begin
  1872. glBitmapDefaultFormat := aFormat;
  1873. end;
  1874. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1875. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1876. begin
  1877. glBitmapDefaultFilterMin := aMin;
  1878. glBitmapDefaultFilterMag := aMag;
  1879. end;
  1880. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1881. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1882. begin
  1883. glBitmapDefaultWrapS := S;
  1884. glBitmapDefaultWrapT := T;
  1885. glBitmapDefaultWrapR := R;
  1886. end;
  1887. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1888. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1889. begin
  1890. glDefaultSwizzle[0] := r;
  1891. glDefaultSwizzle[1] := g;
  1892. glDefaultSwizzle[2] := b;
  1893. glDefaultSwizzle[3] := a;
  1894. end;
  1895. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1896. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1897. begin
  1898. result := glBitmapDefaultDeleteTextureOnFree;
  1899. end;
  1900. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1901. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1902. begin
  1903. result := glBitmapDefaultFreeDataAfterGenTextures;
  1904. end;
  1905. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1906. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1907. begin
  1908. result := glBitmapDefaultMipmap;
  1909. end;
  1910. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1911. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1912. begin
  1913. result := glBitmapDefaultFormat;
  1914. end;
  1915. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1916. procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
  1917. begin
  1918. aMin := glBitmapDefaultFilterMin;
  1919. aMag := glBitmapDefaultFilterMag;
  1920. end;
  1921. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1922. procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
  1923. begin
  1924. S := glBitmapDefaultWrapS;
  1925. T := glBitmapDefaultWrapT;
  1926. R := glBitmapDefaultWrapR;
  1927. end;
  1928. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1929. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1930. begin
  1931. r := glDefaultSwizzle[0];
  1932. g := glDefaultSwizzle[1];
  1933. b := glDefaultSwizzle[2];
  1934. a := glDefaultSwizzle[3];
  1935. end;
  1936. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1937. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1938. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1939. function TFormatDescriptor.GetRedMask: QWord;
  1940. begin
  1941. result := fRange.r shl fShift.r;
  1942. end;
  1943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1944. function TFormatDescriptor.GetGreenMask: QWord;
  1945. begin
  1946. result := fRange.g shl fShift.g;
  1947. end;
  1948. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1949. function TFormatDescriptor.GetBlueMask: QWord;
  1950. begin
  1951. result := fRange.b shl fShift.b;
  1952. end;
  1953. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1954. function TFormatDescriptor.GetAlphaMask: QWord;
  1955. begin
  1956. result := fRange.a shl fShift.a;
  1957. end;
  1958. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1959. function TFormatDescriptor.GetIsCompressed: Boolean;
  1960. begin
  1961. result := fIsCompressed;
  1962. end;
  1963. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1964. function TFormatDescriptor.GetHasRed: Boolean;
  1965. begin
  1966. result := (fRange.r > 0);
  1967. end;
  1968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1969. function TFormatDescriptor.GetHasGreen: Boolean;
  1970. begin
  1971. result := (fRange.g > 0);
  1972. end;
  1973. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1974. function TFormatDescriptor.GetHasBlue: Boolean;
  1975. begin
  1976. result := (fRange.b > 0);
  1977. end;
  1978. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1979. function TFormatDescriptor.GetHasAlpha: Boolean;
  1980. begin
  1981. result := (fRange.a > 0);
  1982. end;
  1983. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1984. function TFormatDescriptor.GetglFormat: GLenum;
  1985. begin
  1986. result := fglFormat;
  1987. end;
  1988. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1989. function TFormatDescriptor.GetglInternalFormat: GLenum;
  1990. begin
  1991. result := fglInternalFormat;
  1992. end;
  1993. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1994. function TFormatDescriptor.GetglDataFormat: GLenum;
  1995. begin
  1996. result := fglDataFormat;
  1997. end;
  1998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1999. function TFormatDescriptor.GetComponents: Integer;
  2000. var
  2001. i: Integer;
  2002. begin
  2003. result := 0;
  2004. for i := 0 to 3 do
  2005. if (fRange.arr[i] > 0) then
  2006. inc(result);
  2007. end;
  2008. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2009. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  2010. var
  2011. w, h: Integer;
  2012. begin
  2013. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  2014. w := Max(1, aSize.X);
  2015. h := Max(1, aSize.Y);
  2016. result := GetSize(w, h);
  2017. end else
  2018. result := 0;
  2019. end;
  2020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2021. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  2022. begin
  2023. result := 0;
  2024. if (aWidth <= 0) or (aHeight <= 0) then
  2025. exit;
  2026. result := Ceil(aWidth * aHeight * fPixelSize);
  2027. end;
  2028. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2029. function TFormatDescriptor.CreateMappingData: Pointer;
  2030. begin
  2031. result := nil;
  2032. end;
  2033. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2034. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2035. begin
  2036. //DUMMY
  2037. end;
  2038. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2039. function TFormatDescriptor.IsEmpty: Boolean;
  2040. begin
  2041. result := (fFormat = tfEmpty);
  2042. end;
  2043. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2044. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  2045. begin
  2046. result := false;
  2047. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2048. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2049. if (aRedMask <> RedMask) then
  2050. exit;
  2051. if (aGreenMask <> GreenMask) then
  2052. exit;
  2053. if (aBlueMask <> BlueMask) then
  2054. exit;
  2055. if (aAlphaMask <> AlphaMask) then
  2056. exit;
  2057. result := true;
  2058. end;
  2059. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2060. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2061. begin
  2062. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2063. aPixel.Data := fRange;
  2064. aPixel.Range := fRange;
  2065. aPixel.Format := fFormat;
  2066. end;
  2067. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2068. constructor TFormatDescriptor.Create;
  2069. begin
  2070. inherited Create;
  2071. fFormat := tfEmpty;
  2072. fWithAlpha := tfEmpty;
  2073. fWithoutAlpha := tfEmpty;
  2074. fRGBInverted := tfEmpty;
  2075. fUncompressed := tfEmpty;
  2076. fPixelSize := 0.0;
  2077. fIsCompressed := false;
  2078. fglFormat := 0;
  2079. fglInternalFormat := 0;
  2080. fglDataFormat := 0;
  2081. FillChar(fRange, 0, SizeOf(fRange));
  2082. FillChar(fShift, 0, SizeOf(fShift));
  2083. end;
  2084. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2085. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2086. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2087. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2088. begin
  2089. aData^ := aPixel.Data.a;
  2090. inc(aData);
  2091. end;
  2092. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2093. begin
  2094. aPixel.Data.r := 0;
  2095. aPixel.Data.g := 0;
  2096. aPixel.Data.b := 0;
  2097. aPixel.Data.a := aData^;
  2098. inc(aData);
  2099. end;
  2100. constructor TfdAlpha_UB1.Create;
  2101. begin
  2102. inherited Create;
  2103. fPixelSize := 1.0;
  2104. fRange.a := $FF;
  2105. fglFormat := GL_ALPHA;
  2106. fglDataFormat := GL_UNSIGNED_BYTE;
  2107. end;
  2108. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2109. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2110. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2111. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2112. begin
  2113. aData^ := LuminanceWeight(aPixel);
  2114. inc(aData);
  2115. end;
  2116. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2117. begin
  2118. aPixel.Data.r := aData^;
  2119. aPixel.Data.g := aData^;
  2120. aPixel.Data.b := aData^;
  2121. aPixel.Data.a := 0;
  2122. inc(aData);
  2123. end;
  2124. constructor TfdLuminance_UB1.Create;
  2125. begin
  2126. inherited Create;
  2127. fPixelSize := 1.0;
  2128. fRange.r := $FF;
  2129. fRange.g := $FF;
  2130. fRange.b := $FF;
  2131. fglFormat := GL_LUMINANCE;
  2132. fglDataFormat := GL_UNSIGNED_BYTE;
  2133. end;
  2134. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2135. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2136. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2137. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2138. var
  2139. i: Integer;
  2140. begin
  2141. aData^ := 0;
  2142. for i := 0 to 3 do
  2143. if (fRange.arr[i] > 0) then
  2144. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2145. inc(aData);
  2146. end;
  2147. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2148. var
  2149. i: Integer;
  2150. begin
  2151. for i := 0 to 3 do
  2152. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2153. inc(aData);
  2154. end;
  2155. constructor TfdUniversal_UB1.Create;
  2156. begin
  2157. inherited Create;
  2158. fPixelSize := 1.0;
  2159. end;
  2160. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2161. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2162. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2163. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2164. begin
  2165. inherited Map(aPixel, aData, aMapData);
  2166. aData^ := aPixel.Data.a;
  2167. inc(aData);
  2168. end;
  2169. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2170. begin
  2171. inherited Unmap(aData, aPixel, aMapData);
  2172. aPixel.Data.a := aData^;
  2173. inc(aData);
  2174. end;
  2175. constructor TfdLuminanceAlpha_UB2.Create;
  2176. begin
  2177. inherited Create;
  2178. fPixelSize := 2.0;
  2179. fRange.a := $FF;
  2180. fShift.a := 8;
  2181. fglFormat := GL_LUMINANCE_ALPHA;
  2182. fglDataFormat := GL_UNSIGNED_BYTE;
  2183. end;
  2184. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2185. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2186. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2187. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2188. begin
  2189. aData^ := aPixel.Data.r;
  2190. inc(aData);
  2191. aData^ := aPixel.Data.g;
  2192. inc(aData);
  2193. aData^ := aPixel.Data.b;
  2194. inc(aData);
  2195. end;
  2196. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2197. begin
  2198. aPixel.Data.r := aData^;
  2199. inc(aData);
  2200. aPixel.Data.g := aData^;
  2201. inc(aData);
  2202. aPixel.Data.b := aData^;
  2203. inc(aData);
  2204. aPixel.Data.a := 0;
  2205. end;
  2206. constructor TfdRGB_UB3.Create;
  2207. begin
  2208. inherited Create;
  2209. fPixelSize := 3.0;
  2210. fRange.r := $FF;
  2211. fRange.g := $FF;
  2212. fRange.b := $FF;
  2213. fShift.r := 0;
  2214. fShift.g := 8;
  2215. fShift.b := 16;
  2216. fglFormat := GL_RGB;
  2217. fglDataFormat := GL_UNSIGNED_BYTE;
  2218. end;
  2219. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2220. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2221. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2222. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2223. begin
  2224. aData^ := aPixel.Data.b;
  2225. inc(aData);
  2226. aData^ := aPixel.Data.g;
  2227. inc(aData);
  2228. aData^ := aPixel.Data.r;
  2229. inc(aData);
  2230. end;
  2231. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2232. begin
  2233. aPixel.Data.b := aData^;
  2234. inc(aData);
  2235. aPixel.Data.g := aData^;
  2236. inc(aData);
  2237. aPixel.Data.r := aData^;
  2238. inc(aData);
  2239. aPixel.Data.a := 0;
  2240. end;
  2241. constructor TfdBGR_UB3.Create;
  2242. begin
  2243. fPixelSize := 3.0;
  2244. fRange.r := $FF;
  2245. fRange.g := $FF;
  2246. fRange.b := $FF;
  2247. fShift.r := 16;
  2248. fShift.g := 8;
  2249. fShift.b := 0;
  2250. fglFormat := GL_BGR;
  2251. fglDataFormat := GL_UNSIGNED_BYTE;
  2252. end;
  2253. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2254. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2255. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2256. procedure TfdRGBA_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 TfdRGBA_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 TfdRGBA_UB4.Create;
  2269. begin
  2270. inherited Create;
  2271. fPixelSize := 4.0;
  2272. fRange.a := $FF;
  2273. fShift.a := 24;
  2274. fglFormat := GL_RGBA;
  2275. fglDataFormat := GL_UNSIGNED_BYTE;
  2276. end;
  2277. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2278. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2279. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2280. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2281. begin
  2282. inherited Map(aPixel, aData, aMapData);
  2283. aData^ := aPixel.Data.a;
  2284. inc(aData);
  2285. end;
  2286. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2287. begin
  2288. inherited Unmap(aData, aPixel, aMapData);
  2289. aPixel.Data.a := aData^;
  2290. inc(aData);
  2291. end;
  2292. constructor TfdBGRA_UB4.Create;
  2293. begin
  2294. inherited Create;
  2295. fPixelSize := 4.0;
  2296. fRange.a := $FF;
  2297. fShift.a := 24;
  2298. fglFormat := GL_BGRA;
  2299. fglDataFormat := GL_UNSIGNED_BYTE;
  2300. end;
  2301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2302. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2303. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2304. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2305. begin
  2306. PWord(aData)^ := aPixel.Data.a;
  2307. inc(aData, 2);
  2308. end;
  2309. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2310. begin
  2311. aPixel.Data.r := 0;
  2312. aPixel.Data.g := 0;
  2313. aPixel.Data.b := 0;
  2314. aPixel.Data.a := PWord(aData)^;
  2315. inc(aData, 2);
  2316. end;
  2317. constructor TfdAlpha_US1.Create;
  2318. begin
  2319. inherited Create;
  2320. fPixelSize := 2.0;
  2321. fRange.a := $FFFF;
  2322. fglFormat := GL_ALPHA;
  2323. fglDataFormat := GL_UNSIGNED_SHORT;
  2324. end;
  2325. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2326. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2327. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2328. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2329. begin
  2330. PWord(aData)^ := LuminanceWeight(aPixel);
  2331. inc(aData, 2);
  2332. end;
  2333. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2334. begin
  2335. aPixel.Data.r := PWord(aData)^;
  2336. aPixel.Data.g := PWord(aData)^;
  2337. aPixel.Data.b := PWord(aData)^;
  2338. aPixel.Data.a := 0;
  2339. inc(aData, 2);
  2340. end;
  2341. constructor TfdLuminance_US1.Create;
  2342. begin
  2343. inherited Create;
  2344. fPixelSize := 2.0;
  2345. fRange.r := $FFFF;
  2346. fRange.g := $FFFF;
  2347. fRange.b := $FFFF;
  2348. fglFormat := GL_LUMINANCE;
  2349. fglDataFormat := GL_UNSIGNED_SHORT;
  2350. end;
  2351. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2352. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2353. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2354. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2355. var
  2356. i: Integer;
  2357. begin
  2358. PWord(aData)^ := 0;
  2359. for i := 0 to 3 do
  2360. if (fRange.arr[i] > 0) then
  2361. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2362. inc(aData, 2);
  2363. end;
  2364. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2365. var
  2366. i: Integer;
  2367. begin
  2368. for i := 0 to 3 do
  2369. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2370. inc(aData, 2);
  2371. end;
  2372. constructor TfdUniversal_US1.Create;
  2373. begin
  2374. inherited Create;
  2375. fPixelSize := 2.0;
  2376. end;
  2377. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2378. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2379. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2380. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2381. begin
  2382. PWord(aData)^ := DepthWeight(aPixel);
  2383. inc(aData, 2);
  2384. end;
  2385. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2386. begin
  2387. aPixel.Data.r := PWord(aData)^;
  2388. aPixel.Data.g := PWord(aData)^;
  2389. aPixel.Data.b := PWord(aData)^;
  2390. aPixel.Data.a := 0;
  2391. inc(aData, 2);
  2392. end;
  2393. constructor TfdDepth_US1.Create;
  2394. begin
  2395. inherited Create;
  2396. fPixelSize := 2.0;
  2397. fRange.r := $FFFF;
  2398. fRange.g := $FFFF;
  2399. fRange.b := $FFFF;
  2400. fglFormat := GL_DEPTH_COMPONENT;
  2401. fglDataFormat := GL_UNSIGNED_SHORT;
  2402. end;
  2403. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2404. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2405. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2406. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2407. begin
  2408. inherited Map(aPixel, aData, aMapData);
  2409. PWord(aData)^ := aPixel.Data.a;
  2410. inc(aData, 2);
  2411. end;
  2412. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2413. begin
  2414. inherited Unmap(aData, aPixel, aMapData);
  2415. aPixel.Data.a := PWord(aData)^;
  2416. inc(aData, 2);
  2417. end;
  2418. constructor TfdLuminanceAlpha_US2.Create;
  2419. begin
  2420. inherited Create;
  2421. fPixelSize := 4.0;
  2422. fRange.a := $FFFF;
  2423. fShift.a := 16;
  2424. fglFormat := GL_LUMINANCE_ALPHA;
  2425. fglDataFormat := GL_UNSIGNED_SHORT;
  2426. end;
  2427. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2428. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2429. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2430. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2431. begin
  2432. PWord(aData)^ := aPixel.Data.r;
  2433. inc(aData, 2);
  2434. PWord(aData)^ := aPixel.Data.g;
  2435. inc(aData, 2);
  2436. PWord(aData)^ := aPixel.Data.b;
  2437. inc(aData, 2);
  2438. end;
  2439. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2440. begin
  2441. aPixel.Data.r := PWord(aData)^;
  2442. inc(aData, 2);
  2443. aPixel.Data.g := PWord(aData)^;
  2444. inc(aData, 2);
  2445. aPixel.Data.b := PWord(aData)^;
  2446. inc(aData, 2);
  2447. aPixel.Data.a := 0;
  2448. end;
  2449. constructor TfdRGB_US3.Create;
  2450. begin
  2451. inherited Create;
  2452. fPixelSize := 6.0;
  2453. fRange.r := $FFFF;
  2454. fRange.g := $FFFF;
  2455. fRange.b := $FFFF;
  2456. fShift.r := 0;
  2457. fShift.g := 16;
  2458. fShift.b := 32;
  2459. fglFormat := GL_RGB;
  2460. fglDataFormat := GL_UNSIGNED_SHORT;
  2461. end;
  2462. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2463. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2464. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2465. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2466. begin
  2467. PWord(aData)^ := aPixel.Data.b;
  2468. inc(aData, 2);
  2469. PWord(aData)^ := aPixel.Data.g;
  2470. inc(aData, 2);
  2471. PWord(aData)^ := aPixel.Data.r;
  2472. inc(aData, 2);
  2473. end;
  2474. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2475. begin
  2476. aPixel.Data.b := PWord(aData)^;
  2477. inc(aData, 2);
  2478. aPixel.Data.g := PWord(aData)^;
  2479. inc(aData, 2);
  2480. aPixel.Data.r := PWord(aData)^;
  2481. inc(aData, 2);
  2482. aPixel.Data.a := 0;
  2483. end;
  2484. constructor TfdBGR_US3.Create;
  2485. begin
  2486. inherited Create;
  2487. fPixelSize := 6.0;
  2488. fRange.r := $FFFF;
  2489. fRange.g := $FFFF;
  2490. fRange.b := $FFFF;
  2491. fShift.r := 32;
  2492. fShift.g := 16;
  2493. fShift.b := 0;
  2494. fglFormat := GL_BGR;
  2495. fglDataFormat := GL_UNSIGNED_SHORT;
  2496. end;
  2497. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2498. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2499. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2500. procedure TfdRGBA_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 TfdRGBA_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 TfdRGBA_US4.Create;
  2513. begin
  2514. inherited Create;
  2515. fPixelSize := 8.0;
  2516. fRange.a := $FFFF;
  2517. fShift.a := 48;
  2518. fglFormat := GL_RGBA;
  2519. fglDataFormat := GL_UNSIGNED_SHORT;
  2520. end;
  2521. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2522. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2523. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2524. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2525. begin
  2526. inherited Map(aPixel, aData, aMapData);
  2527. PWord(aData)^ := aPixel.Data.a;
  2528. inc(aData, 2);
  2529. end;
  2530. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2531. begin
  2532. inherited Unmap(aData, aPixel, aMapData);
  2533. aPixel.Data.a := PWord(aData)^;
  2534. inc(aData, 2);
  2535. end;
  2536. constructor TfdBGRA_US4.Create;
  2537. begin
  2538. inherited Create;
  2539. fPixelSize := 8.0;
  2540. fRange.a := $FFFF;
  2541. fShift.a := 48;
  2542. fglFormat := GL_BGRA;
  2543. fglDataFormat := GL_UNSIGNED_SHORT;
  2544. end;
  2545. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2546. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2547. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2548. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2549. var
  2550. i: Integer;
  2551. begin
  2552. PCardinal(aData)^ := 0;
  2553. for i := 0 to 3 do
  2554. if (fRange.arr[i] > 0) then
  2555. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2556. inc(aData, 4);
  2557. end;
  2558. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2559. var
  2560. i: Integer;
  2561. begin
  2562. for i := 0 to 3 do
  2563. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2564. inc(aData, 2);
  2565. end;
  2566. constructor TfdUniversal_UI1.Create;
  2567. begin
  2568. inherited Create;
  2569. fPixelSize := 4.0;
  2570. end;
  2571. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2572. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2574. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2575. begin
  2576. PCardinal(aData)^ := DepthWeight(aPixel);
  2577. inc(aData, 4);
  2578. end;
  2579. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2580. begin
  2581. aPixel.Data.r := PCardinal(aData)^;
  2582. aPixel.Data.g := PCardinal(aData)^;
  2583. aPixel.Data.b := PCardinal(aData)^;
  2584. aPixel.Data.a := 0;
  2585. inc(aData, 4);
  2586. end;
  2587. constructor TfdDepth_UI1.Create;
  2588. begin
  2589. inherited Create;
  2590. fPixelSize := 4.0;
  2591. fRange.r := $FFFFFFFF;
  2592. fRange.g := $FFFFFFFF;
  2593. fRange.b := $FFFFFFFF;
  2594. fglFormat := GL_DEPTH_COMPONENT;
  2595. fglDataFormat := GL_UNSIGNED_INT;
  2596. end;
  2597. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2598. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2599. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2600. constructor TfdAlpha4.Create;
  2601. begin
  2602. inherited Create;
  2603. fFormat := tfAlpha4;
  2604. fWithAlpha := tfAlpha4;
  2605. fglInternalFormat := GL_ALPHA4;
  2606. end;
  2607. constructor TfdAlpha8.Create;
  2608. begin
  2609. inherited Create;
  2610. fFormat := tfAlpha8;
  2611. fWithAlpha := tfAlpha8;
  2612. fglInternalFormat := GL_ALPHA8;
  2613. end;
  2614. constructor TfdAlpha12.Create;
  2615. begin
  2616. inherited Create;
  2617. fFormat := tfAlpha12;
  2618. fWithAlpha := tfAlpha12;
  2619. fglInternalFormat := GL_ALPHA12;
  2620. end;
  2621. constructor TfdAlpha16.Create;
  2622. begin
  2623. inherited Create;
  2624. fFormat := tfAlpha16;
  2625. fWithAlpha := tfAlpha16;
  2626. fglInternalFormat := GL_ALPHA16;
  2627. end;
  2628. constructor TfdLuminance4.Create;
  2629. begin
  2630. inherited Create;
  2631. fFormat := tfLuminance4;
  2632. fWithAlpha := tfLuminance4Alpha4;
  2633. fWithoutAlpha := tfLuminance4;
  2634. fglInternalFormat := GL_LUMINANCE4;
  2635. end;
  2636. constructor TfdLuminance8.Create;
  2637. begin
  2638. inherited Create;
  2639. fFormat := tfLuminance8;
  2640. fWithAlpha := tfLuminance8Alpha8;
  2641. fWithoutAlpha := tfLuminance8;
  2642. fglInternalFormat := GL_LUMINANCE8;
  2643. end;
  2644. constructor TfdLuminance12.Create;
  2645. begin
  2646. inherited Create;
  2647. fFormat := tfLuminance12;
  2648. fWithAlpha := tfLuminance12Alpha12;
  2649. fWithoutAlpha := tfLuminance12;
  2650. fglInternalFormat := GL_LUMINANCE12;
  2651. end;
  2652. constructor TfdLuminance16.Create;
  2653. begin
  2654. inherited Create;
  2655. fFormat := tfLuminance16;
  2656. fWithAlpha := tfLuminance16Alpha16;
  2657. fWithoutAlpha := tfLuminance16;
  2658. fglInternalFormat := GL_LUMINANCE16;
  2659. end;
  2660. constructor TfdLuminance4Alpha4.Create;
  2661. begin
  2662. inherited Create;
  2663. fFormat := tfLuminance4Alpha4;
  2664. fWithAlpha := tfLuminance4Alpha4;
  2665. fWithoutAlpha := tfLuminance4;
  2666. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2667. end;
  2668. constructor TfdLuminance6Alpha2.Create;
  2669. begin
  2670. inherited Create;
  2671. fFormat := tfLuminance6Alpha2;
  2672. fWithAlpha := tfLuminance6Alpha2;
  2673. fWithoutAlpha := tfLuminance8;
  2674. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2675. end;
  2676. constructor TfdLuminance8Alpha8.Create;
  2677. begin
  2678. inherited Create;
  2679. fFormat := tfLuminance8Alpha8;
  2680. fWithAlpha := tfLuminance8Alpha8;
  2681. fWithoutAlpha := tfLuminance8;
  2682. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2683. end;
  2684. constructor TfdLuminance12Alpha4.Create;
  2685. begin
  2686. inherited Create;
  2687. fFormat := tfLuminance12Alpha4;
  2688. fWithAlpha := tfLuminance12Alpha4;
  2689. fWithoutAlpha := tfLuminance12;
  2690. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2691. end;
  2692. constructor TfdLuminance12Alpha12.Create;
  2693. begin
  2694. inherited Create;
  2695. fFormat := tfLuminance12Alpha12;
  2696. fWithAlpha := tfLuminance12Alpha12;
  2697. fWithoutAlpha := tfLuminance12;
  2698. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2699. end;
  2700. constructor TfdLuminance16Alpha16.Create;
  2701. begin
  2702. inherited Create;
  2703. fFormat := tfLuminance16Alpha16;
  2704. fWithAlpha := tfLuminance16Alpha16;
  2705. fWithoutAlpha := tfLuminance16;
  2706. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2707. end;
  2708. constructor TfdR3G3B2.Create;
  2709. begin
  2710. inherited Create;
  2711. fFormat := tfR3G3B2;
  2712. fWithAlpha := tfRGBA2;
  2713. fWithoutAlpha := tfR3G3B2;
  2714. fRange.r := $7;
  2715. fRange.g := $7;
  2716. fRange.b := $3;
  2717. fShift.r := 0;
  2718. fShift.g := 3;
  2719. fShift.b := 6;
  2720. fglFormat := GL_RGB;
  2721. fglInternalFormat := GL_R3_G3_B2;
  2722. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2723. end;
  2724. constructor TfdRGB4.Create;
  2725. begin
  2726. inherited Create;
  2727. fFormat := tfRGB4;
  2728. fWithAlpha := tfRGBA4;
  2729. fWithoutAlpha := tfRGB4;
  2730. fRGBInverted := tfBGR4;
  2731. fRange.r := $F;
  2732. fRange.g := $F;
  2733. fRange.b := $F;
  2734. fShift.r := 0;
  2735. fShift.g := 4;
  2736. fShift.b := 8;
  2737. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2738. fglInternalFormat := GL_RGB4;
  2739. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2740. end;
  2741. constructor TfdR5G6B5.Create;
  2742. begin
  2743. inherited Create;
  2744. fFormat := tfR5G6B5;
  2745. fWithAlpha := tfRGBA4;
  2746. fWithoutAlpha := tfR5G6B5;
  2747. fRGBInverted := tfB5G6R5;
  2748. fRange.r := $1F;
  2749. fRange.g := $3F;
  2750. fRange.b := $1F;
  2751. fShift.r := 0;
  2752. fShift.g := 5;
  2753. fShift.b := 11;
  2754. fglFormat := GL_RGB;
  2755. fglInternalFormat := GL_RGB565;
  2756. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2757. end;
  2758. constructor TfdRGB5.Create;
  2759. begin
  2760. inherited Create;
  2761. fFormat := tfRGB5;
  2762. fWithAlpha := tfRGB5A1;
  2763. fWithoutAlpha := tfRGB5;
  2764. fRGBInverted := tfBGR5;
  2765. fRange.r := $1F;
  2766. fRange.g := $1F;
  2767. fRange.b := $1F;
  2768. fShift.r := 0;
  2769. fShift.g := 5;
  2770. fShift.b := 10;
  2771. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2772. fglInternalFormat := GL_RGB5;
  2773. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2774. end;
  2775. constructor TfdRGB8.Create;
  2776. begin
  2777. inherited Create;
  2778. fFormat := tfRGB8;
  2779. fWithAlpha := tfRGBA8;
  2780. fWithoutAlpha := tfRGB8;
  2781. fRGBInverted := tfBGR8;
  2782. fglInternalFormat := GL_RGB8;
  2783. end;
  2784. constructor TfdRGB10.Create;
  2785. begin
  2786. inherited Create;
  2787. fFormat := tfRGB10;
  2788. fWithAlpha := tfRGB10A2;
  2789. fWithoutAlpha := tfRGB10;
  2790. fRGBInverted := tfBGR10;
  2791. fRange.r := $3FF;
  2792. fRange.g := $3FF;
  2793. fRange.b := $3FF;
  2794. fShift.r := 0;
  2795. fShift.g := 10;
  2796. fShift.b := 20;
  2797. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2798. fglInternalFormat := GL_RGB10;
  2799. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2800. end;
  2801. constructor TfdRGB12.Create;
  2802. begin
  2803. inherited Create;
  2804. fFormat := tfRGB12;
  2805. fWithAlpha := tfRGBA12;
  2806. fWithoutAlpha := tfRGB12;
  2807. fRGBInverted := tfBGR12;
  2808. fglInternalFormat := GL_RGB12;
  2809. end;
  2810. constructor TfdRGB16.Create;
  2811. begin
  2812. inherited Create;
  2813. fFormat := tfRGB16;
  2814. fWithAlpha := tfRGBA16;
  2815. fWithoutAlpha := tfRGB16;
  2816. fRGBInverted := tfBGR16;
  2817. fglInternalFormat := GL_RGB16;
  2818. end;
  2819. constructor TfdRGBA2.Create;
  2820. begin
  2821. inherited Create;
  2822. fFormat := tfRGBA2;
  2823. fWithAlpha := tfRGBA2;
  2824. fWithoutAlpha := tfR3G3B2;
  2825. fRGBInverted := tfBGRA2;
  2826. fglInternalFormat := GL_RGBA2;
  2827. end;
  2828. constructor TfdRGBA4.Create;
  2829. begin
  2830. inherited Create;
  2831. fFormat := tfRGBA4;
  2832. fWithAlpha := tfRGBA4;
  2833. fWithoutAlpha := tfRGB4;
  2834. fRGBInverted := tfBGRA4;
  2835. fRange.r := $F;
  2836. fRange.g := $F;
  2837. fRange.b := $F;
  2838. fRange.a := $F;
  2839. fShift.r := 0;
  2840. fShift.g := 4;
  2841. fShift.b := 8;
  2842. fShift.a := 12;
  2843. fglFormat := GL_RGBA;
  2844. fglInternalFormat := GL_RGBA4;
  2845. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2846. end;
  2847. constructor TfdRGB5A1.Create;
  2848. begin
  2849. inherited Create;
  2850. fFormat := tfRGB5A1;
  2851. fWithAlpha := tfRGB5A1;
  2852. fWithoutAlpha := tfRGB5;
  2853. fRGBInverted := tfBGR5A1;
  2854. fRange.r := $1F;
  2855. fRange.g := $1F;
  2856. fRange.b := $1F;
  2857. fRange.a := $01;
  2858. fShift.r := 0;
  2859. fShift.g := 5;
  2860. fShift.b := 10;
  2861. fShift.a := 15;
  2862. fglFormat := GL_RGBA;
  2863. fglInternalFormat := GL_RGB5_A1;
  2864. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2865. end;
  2866. constructor TfdRGBA8.Create;
  2867. begin
  2868. inherited Create;
  2869. fFormat := tfRGBA8;
  2870. fWithAlpha := tfRGBA8;
  2871. fWithoutAlpha := tfRGB8;
  2872. fRGBInverted := tfBGRA8;
  2873. fglInternalFormat := GL_RGBA8;
  2874. end;
  2875. constructor TfdRGB10A2.Create;
  2876. begin
  2877. inherited Create;
  2878. fFormat := tfRGB10A2;
  2879. fWithAlpha := tfRGB10A2;
  2880. fWithoutAlpha := tfRGB10;
  2881. fRGBInverted := tfBGR10A2;
  2882. fRange.r := $3FF;
  2883. fRange.g := $3FF;
  2884. fRange.b := $3FF;
  2885. fRange.a := $003;
  2886. fShift.r := 0;
  2887. fShift.g := 10;
  2888. fShift.b := 20;
  2889. fShift.a := 30;
  2890. fglFormat := GL_RGBA;
  2891. fglInternalFormat := GL_RGB10_A2;
  2892. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2893. end;
  2894. constructor TfdRGBA12.Create;
  2895. begin
  2896. inherited Create;
  2897. fFormat := tfRGBA12;
  2898. fWithAlpha := tfRGBA12;
  2899. fWithoutAlpha := tfRGB12;
  2900. fRGBInverted := tfBGRA12;
  2901. fglInternalFormat := GL_RGBA12;
  2902. end;
  2903. constructor TfdRGBA16.Create;
  2904. begin
  2905. inherited Create;
  2906. fFormat := tfRGBA16;
  2907. fWithAlpha := tfRGBA16;
  2908. fWithoutAlpha := tfRGB16;
  2909. fRGBInverted := tfBGRA16;
  2910. fglInternalFormat := GL_RGBA16;
  2911. end;
  2912. constructor TfdBGR4.Create;
  2913. begin
  2914. inherited Create;
  2915. fPixelSize := 2.0;
  2916. fFormat := tfBGR4;
  2917. fWithAlpha := tfBGRA4;
  2918. fWithoutAlpha := tfBGR4;
  2919. fRGBInverted := tfRGB4;
  2920. fRange.r := $F;
  2921. fRange.g := $F;
  2922. fRange.b := $F;
  2923. fRange.a := $0;
  2924. fShift.r := 8;
  2925. fShift.g := 4;
  2926. fShift.b := 0;
  2927. fShift.a := 0;
  2928. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2929. fglInternalFormat := GL_RGB4;
  2930. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2931. end;
  2932. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2933. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2934. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2935. constructor TfdB5G6R5.Create;
  2936. begin
  2937. inherited Create;
  2938. fFormat := tfB5G6R5;
  2939. fWithAlpha := tfBGRA4;
  2940. fWithoutAlpha := tfB5G6R5;
  2941. fRGBInverted := tfR5G6B5;
  2942. fRange.r := $1F;
  2943. fRange.g := $3F;
  2944. fRange.b := $1F;
  2945. fShift.r := 11;
  2946. fShift.g := 5;
  2947. fShift.b := 0;
  2948. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2949. fglInternalFormat := GL_RGB8;
  2950. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2951. end;
  2952. constructor TfdBGR5.Create;
  2953. begin
  2954. inherited Create;
  2955. fPixelSize := 2.0;
  2956. fFormat := tfBGR5;
  2957. fWithAlpha := tfBGR5A1;
  2958. fWithoutAlpha := tfBGR5;
  2959. fRGBInverted := tfRGB5;
  2960. fRange.r := $1F;
  2961. fRange.g := $1F;
  2962. fRange.b := $1F;
  2963. fRange.a := $00;
  2964. fShift.r := 10;
  2965. fShift.g := 5;
  2966. fShift.b := 0;
  2967. fShift.a := 0;
  2968. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2969. fglInternalFormat := GL_RGB5;
  2970. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2971. end;
  2972. constructor TfdBGR8.Create;
  2973. begin
  2974. inherited Create;
  2975. fFormat := tfBGR8;
  2976. fWithAlpha := tfBGRA8;
  2977. fWithoutAlpha := tfBGR8;
  2978. fRGBInverted := tfRGB8;
  2979. fglInternalFormat := GL_RGB8;
  2980. end;
  2981. constructor TfdBGR10.Create;
  2982. begin
  2983. inherited Create;
  2984. fFormat := tfBGR10;
  2985. fWithAlpha := tfBGR10A2;
  2986. fWithoutAlpha := tfBGR10;
  2987. fRGBInverted := tfRGB10;
  2988. fRange.r := $3FF;
  2989. fRange.g := $3FF;
  2990. fRange.b := $3FF;
  2991. fRange.a := $000;
  2992. fShift.r := 20;
  2993. fShift.g := 10;
  2994. fShift.b := 0;
  2995. fShift.a := 0;
  2996. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2997. fglInternalFormat := GL_RGB10;
  2998. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2999. end;
  3000. constructor TfdBGR12.Create;
  3001. begin
  3002. inherited Create;
  3003. fFormat := tfBGR12;
  3004. fWithAlpha := tfBGRA12;
  3005. fWithoutAlpha := tfBGR12;
  3006. fRGBInverted := tfRGB12;
  3007. fglInternalFormat := GL_RGB12;
  3008. end;
  3009. constructor TfdBGR16.Create;
  3010. begin
  3011. inherited Create;
  3012. fFormat := tfBGR16;
  3013. fWithAlpha := tfBGRA16;
  3014. fWithoutAlpha := tfBGR16;
  3015. fRGBInverted := tfRGB16;
  3016. fglInternalFormat := GL_RGB16;
  3017. end;
  3018. constructor TfdBGRA2.Create;
  3019. begin
  3020. inherited Create;
  3021. fFormat := tfBGRA2;
  3022. fWithAlpha := tfBGRA4;
  3023. fWithoutAlpha := tfBGR4;
  3024. fRGBInverted := tfRGBA2;
  3025. fglInternalFormat := GL_RGBA2;
  3026. end;
  3027. constructor TfdBGRA4.Create;
  3028. begin
  3029. inherited Create;
  3030. fFormat := tfBGRA4;
  3031. fWithAlpha := tfBGRA4;
  3032. fWithoutAlpha := tfBGR4;
  3033. fRGBInverted := tfRGBA4;
  3034. fRange.r := $F;
  3035. fRange.g := $F;
  3036. fRange.b := $F;
  3037. fRange.a := $F;
  3038. fShift.r := 8;
  3039. fShift.g := 4;
  3040. fShift.b := 0;
  3041. fShift.a := 12;
  3042. fglFormat := GL_BGRA;
  3043. fglInternalFormat := GL_RGBA4;
  3044. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3045. end;
  3046. constructor TfdBGR5A1.Create;
  3047. begin
  3048. inherited Create;
  3049. fFormat := tfBGR5A1;
  3050. fWithAlpha := tfBGR5A1;
  3051. fWithoutAlpha := tfBGR5;
  3052. fRGBInverted := tfRGB5A1;
  3053. fRange.r := $1F;
  3054. fRange.g := $1F;
  3055. fRange.b := $1F;
  3056. fRange.a := $01;
  3057. fShift.r := 10;
  3058. fShift.g := 5;
  3059. fShift.b := 0;
  3060. fShift.a := 15;
  3061. fglFormat := GL_BGRA;
  3062. fglInternalFormat := GL_RGB5_A1;
  3063. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3064. end;
  3065. constructor TfdBGRA8.Create;
  3066. begin
  3067. inherited Create;
  3068. fFormat := tfBGRA8;
  3069. fWithAlpha := tfBGRA8;
  3070. fWithoutAlpha := tfBGR8;
  3071. fRGBInverted := tfRGBA8;
  3072. fglInternalFormat := GL_RGBA8;
  3073. end;
  3074. constructor TfdBGR10A2.Create;
  3075. begin
  3076. inherited Create;
  3077. fFormat := tfBGR10A2;
  3078. fWithAlpha := tfBGR10A2;
  3079. fWithoutAlpha := tfBGR10;
  3080. fRGBInverted := tfRGB10A2;
  3081. fRange.r := $3FF;
  3082. fRange.g := $3FF;
  3083. fRange.b := $3FF;
  3084. fRange.a := $003;
  3085. fShift.r := 20;
  3086. fShift.g := 10;
  3087. fShift.b := 0;
  3088. fShift.a := 30;
  3089. fglFormat := GL_BGRA;
  3090. fglInternalFormat := GL_RGB10_A2;
  3091. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3092. end;
  3093. constructor TfdBGRA12.Create;
  3094. begin
  3095. inherited Create;
  3096. fFormat := tfBGRA12;
  3097. fWithAlpha := tfBGRA12;
  3098. fWithoutAlpha := tfBGR12;
  3099. fRGBInverted := tfRGBA12;
  3100. fglInternalFormat := GL_RGBA12;
  3101. end;
  3102. constructor TfdBGRA16.Create;
  3103. begin
  3104. inherited Create;
  3105. fFormat := tfBGRA16;
  3106. fWithAlpha := tfBGRA16;
  3107. fWithoutAlpha := tfBGR16;
  3108. fRGBInverted := tfRGBA16;
  3109. fglInternalFormat := GL_RGBA16;
  3110. end;
  3111. constructor TfdDepth16.Create;
  3112. begin
  3113. inherited Create;
  3114. fFormat := tfDepth16;
  3115. fWithAlpha := tfEmpty;
  3116. fWithoutAlpha := tfDepth16;
  3117. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3118. end;
  3119. constructor TfdDepth24.Create;
  3120. begin
  3121. inherited Create;
  3122. fFormat := tfDepth24;
  3123. fWithAlpha := tfEmpty;
  3124. fWithoutAlpha := tfDepth24;
  3125. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3126. end;
  3127. constructor TfdDepth32.Create;
  3128. begin
  3129. inherited Create;
  3130. fFormat := tfDepth32;
  3131. fWithAlpha := tfEmpty;
  3132. fWithoutAlpha := tfDepth32;
  3133. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3134. end;
  3135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3136. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3138. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3139. begin
  3140. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3141. end;
  3142. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3143. begin
  3144. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3145. end;
  3146. constructor TfdS3tcDtx1RGBA.Create;
  3147. begin
  3148. inherited Create;
  3149. fFormat := tfS3tcDtx1RGBA;
  3150. fWithAlpha := tfS3tcDtx1RGBA;
  3151. fUncompressed := tfRGB5A1;
  3152. fPixelSize := 0.5;
  3153. fIsCompressed := true;
  3154. fglFormat := GL_COMPRESSED_RGBA;
  3155. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3156. fglDataFormat := GL_UNSIGNED_BYTE;
  3157. end;
  3158. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3159. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3160. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3161. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3162. begin
  3163. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3164. end;
  3165. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3166. begin
  3167. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3168. end;
  3169. constructor TfdS3tcDtx3RGBA.Create;
  3170. begin
  3171. inherited Create;
  3172. fFormat := tfS3tcDtx3RGBA;
  3173. fWithAlpha := tfS3tcDtx3RGBA;
  3174. fUncompressed := tfRGBA8;
  3175. fPixelSize := 1.0;
  3176. fIsCompressed := true;
  3177. fglFormat := GL_COMPRESSED_RGBA;
  3178. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3179. fglDataFormat := GL_UNSIGNED_BYTE;
  3180. end;
  3181. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3182. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3183. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3184. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3185. begin
  3186. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3187. end;
  3188. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3189. begin
  3190. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3191. end;
  3192. constructor TfdS3tcDtx5RGBA.Create;
  3193. begin
  3194. inherited Create;
  3195. fFormat := tfS3tcDtx3RGBA;
  3196. fWithAlpha := tfS3tcDtx3RGBA;
  3197. fUncompressed := tfRGBA8;
  3198. fPixelSize := 1.0;
  3199. fIsCompressed := true;
  3200. fglFormat := GL_COMPRESSED_RGBA;
  3201. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3202. fglDataFormat := GL_UNSIGNED_BYTE;
  3203. end;
  3204. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3205. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3206. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3207. class procedure TFormatDescriptor.Init;
  3208. begin
  3209. if not Assigned(FormatDescriptorCS) then
  3210. FormatDescriptorCS := TCriticalSection.Create;
  3211. end;
  3212. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3213. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3214. begin
  3215. FormatDescriptorCS.Enter;
  3216. try
  3217. result := FormatDescriptors[aFormat];
  3218. if not Assigned(result) then begin
  3219. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3220. FormatDescriptors[aFormat] := result;
  3221. end;
  3222. finally
  3223. FormatDescriptorCS.Leave;
  3224. end;
  3225. end;
  3226. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3227. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3228. begin
  3229. result := Get(Get(aFormat).WithAlpha);
  3230. end;
  3231. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3232. class procedure TFormatDescriptor.Clear;
  3233. var
  3234. f: TglBitmapFormat;
  3235. begin
  3236. FormatDescriptorCS.Enter;
  3237. try
  3238. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3239. FreeAndNil(FormatDescriptors[f]);
  3240. finally
  3241. FormatDescriptorCS.Leave;
  3242. end;
  3243. end;
  3244. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3245. class procedure TFormatDescriptor.Finalize;
  3246. begin
  3247. Clear;
  3248. FreeAndNil(FormatDescriptorCS);
  3249. end;
  3250. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3251. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3252. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3253. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3254. begin
  3255. Update(aValue, fRange.r, fShift.r);
  3256. end;
  3257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3258. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3259. begin
  3260. Update(aValue, fRange.g, fShift.g);
  3261. end;
  3262. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3263. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3264. begin
  3265. Update(aValue, fRange.b, fShift.b);
  3266. end;
  3267. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3268. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3269. begin
  3270. Update(aValue, fRange.a, fShift.a);
  3271. end;
  3272. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3273. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3274. aShift: Byte);
  3275. begin
  3276. aShift := 0;
  3277. aRange := 0;
  3278. if (aMask = 0) then
  3279. exit;
  3280. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3281. inc(aShift);
  3282. aMask := aMask shr 1;
  3283. end;
  3284. aRange := 1;
  3285. while (aMask > 0) do begin
  3286. aRange := aRange shl 1;
  3287. aMask := aMask shr 1;
  3288. end;
  3289. dec(aRange);
  3290. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3291. end;
  3292. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3293. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3294. var
  3295. data: QWord;
  3296. s: Integer;
  3297. begin
  3298. data :=
  3299. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3300. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3301. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3302. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3303. s := Round(fPixelSize);
  3304. case s of
  3305. 1: aData^ := data;
  3306. 2: PWord(aData)^ := data;
  3307. 4: PCardinal(aData)^ := data;
  3308. 8: PQWord(aData)^ := data;
  3309. else
  3310. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3311. end;
  3312. inc(aData, s);
  3313. end;
  3314. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3315. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3316. var
  3317. data: QWord;
  3318. s, i: Integer;
  3319. begin
  3320. s := Round(fPixelSize);
  3321. case s of
  3322. 1: data := aData^;
  3323. 2: data := PWord(aData)^;
  3324. 4: data := PCardinal(aData)^;
  3325. 8: data := PQWord(aData)^;
  3326. else
  3327. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3328. end;
  3329. for i := 0 to 3 do
  3330. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3331. inc(aData, s);
  3332. end;
  3333. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3334. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3335. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3336. procedure TbmpColorTableFormat.CreateColorTable;
  3337. var
  3338. i: Integer;
  3339. begin
  3340. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3341. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3342. if (Format = tfLuminance4) then
  3343. SetLength(fColorTable, 16)
  3344. else
  3345. SetLength(fColorTable, 256);
  3346. case Format of
  3347. tfLuminance4: begin
  3348. for i := 0 to High(fColorTable) do begin
  3349. fColorTable[i].r := 16 * i;
  3350. fColorTable[i].g := 16 * i;
  3351. fColorTable[i].b := 16 * i;
  3352. fColorTable[i].a := 0;
  3353. end;
  3354. end;
  3355. tfLuminance8: begin
  3356. for i := 0 to High(fColorTable) do begin
  3357. fColorTable[i].r := i;
  3358. fColorTable[i].g := i;
  3359. fColorTable[i].b := i;
  3360. fColorTable[i].a := 0;
  3361. end;
  3362. end;
  3363. tfR3G3B2: begin
  3364. for i := 0 to High(fColorTable) do begin
  3365. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3366. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3367. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3368. fColorTable[i].a := 0;
  3369. end;
  3370. end;
  3371. end;
  3372. end;
  3373. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3374. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3375. var
  3376. d: Byte;
  3377. begin
  3378. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3379. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3380. case Format of
  3381. tfLuminance4: begin
  3382. if (aMapData = nil) then
  3383. aData^ := 0;
  3384. d := LuminanceWeight(aPixel) and Range.r;
  3385. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3386. inc(PByte(aMapData), 4);
  3387. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3388. inc(aData);
  3389. aMapData := nil;
  3390. end;
  3391. end;
  3392. tfLuminance8: begin
  3393. aData^ := LuminanceWeight(aPixel) and Range.r;
  3394. inc(aData);
  3395. end;
  3396. tfR3G3B2: begin
  3397. aData^ := Round(
  3398. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3399. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3400. ((aPixel.Data.b and Range.b) shl Shift.b));
  3401. inc(aData);
  3402. end;
  3403. end;
  3404. end;
  3405. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3406. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3407. var
  3408. idx: QWord;
  3409. s: Integer;
  3410. bits: Byte;
  3411. f: Single;
  3412. begin
  3413. s := Trunc(fPixelSize);
  3414. f := fPixelSize - s;
  3415. bits := Round(8 * f);
  3416. case s of
  3417. 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
  3418. 1: idx := aData^;
  3419. 2: idx := PWord(aData)^;
  3420. 4: idx := PCardinal(aData)^;
  3421. 8: idx := PQWord(aData)^;
  3422. else
  3423. raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3424. end;
  3425. if (idx >= Length(fColorTable)) then
  3426. raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
  3427. with fColorTable[idx] do begin
  3428. aPixel.Data.r := r;
  3429. aPixel.Data.g := g;
  3430. aPixel.Data.b := b;
  3431. aPixel.Data.a := a;
  3432. end;
  3433. inc(PByte(aMapData), bits);
  3434. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3435. inc(aData, 1);
  3436. dec(PByte(aMapData), 8);
  3437. end;
  3438. inc(aData, s);
  3439. end;
  3440. destructor TbmpColorTableFormat.Destroy;
  3441. begin
  3442. SetLength(fColorTable, 0);
  3443. inherited Destroy;
  3444. end;
  3445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3446. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3447. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3448. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3449. var
  3450. i: Integer;
  3451. begin
  3452. for i := 0 to 3 do begin
  3453. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3454. if (aSourceFD.Range.arr[i] > 0) then
  3455. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3456. else
  3457. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3458. end;
  3459. end;
  3460. end;
  3461. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3462. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3463. begin
  3464. with aFuncRec do begin
  3465. if (Source.Range.r > 0) then
  3466. Dest.Data.r := Source.Data.r;
  3467. if (Source.Range.g > 0) then
  3468. Dest.Data.g := Source.Data.g;
  3469. if (Source.Range.b > 0) then
  3470. Dest.Data.b := Source.Data.b;
  3471. if (Source.Range.a > 0) then
  3472. Dest.Data.a := Source.Data.a;
  3473. end;
  3474. end;
  3475. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3476. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3477. var
  3478. i: Integer;
  3479. begin
  3480. with aFuncRec do begin
  3481. for i := 0 to 3 do
  3482. if (Source.Range.arr[i] > 0) then
  3483. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3484. end;
  3485. end;
  3486. type
  3487. TShiftData = packed record
  3488. case Integer of
  3489. 0: (r, g, b, a: SmallInt);
  3490. 1: (arr: array[0..3] of SmallInt);
  3491. end;
  3492. PShiftData = ^TShiftData;
  3493. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3494. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3495. var
  3496. i: Integer;
  3497. begin
  3498. with aFuncRec do
  3499. for i := 0 to 3 do
  3500. if (Source.Range.arr[i] > 0) then
  3501. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3502. end;
  3503. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3504. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3505. begin
  3506. with aFuncRec do begin
  3507. Dest.Data := Source.Data;
  3508. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3509. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3510. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3511. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3512. end;
  3513. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3514. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3515. end;
  3516. end;
  3517. end;
  3518. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3519. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3520. var
  3521. i: Integer;
  3522. begin
  3523. with aFuncRec do begin
  3524. for i := 0 to 3 do
  3525. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3526. end;
  3527. end;
  3528. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3529. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3530. var
  3531. Temp: Single;
  3532. begin
  3533. with FuncRec do begin
  3534. if (FuncRec.Args = nil) then begin //source has no alpha
  3535. Temp :=
  3536. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3537. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3538. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3539. Dest.Data.a := Round(Dest.Range.a * Temp);
  3540. end else
  3541. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3542. end;
  3543. end;
  3544. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3545. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3546. type
  3547. PglBitmapPixelData = ^TglBitmapPixelData;
  3548. begin
  3549. with FuncRec do begin
  3550. Dest.Data.r := Source.Data.r;
  3551. Dest.Data.g := Source.Data.g;
  3552. Dest.Data.b := Source.Data.b;
  3553. with PglBitmapPixelData(Args)^ do
  3554. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3555. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3556. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3557. Dest.Data.a := 0
  3558. else
  3559. Dest.Data.a := Dest.Range.a;
  3560. end;
  3561. end;
  3562. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3563. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3564. begin
  3565. with FuncRec do begin
  3566. Dest.Data.r := Source.Data.r;
  3567. Dest.Data.g := Source.Data.g;
  3568. Dest.Data.b := Source.Data.b;
  3569. Dest.Data.a := PCardinal(Args)^;
  3570. end;
  3571. end;
  3572. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3573. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3574. type
  3575. PRGBPix = ^TRGBPix;
  3576. TRGBPix = array [0..2] of byte;
  3577. var
  3578. Temp: Byte;
  3579. begin
  3580. while aWidth > 0 do begin
  3581. Temp := PRGBPix(aData)^[0];
  3582. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3583. PRGBPix(aData)^[2] := Temp;
  3584. if aHasAlpha then
  3585. Inc(aData, 4)
  3586. else
  3587. Inc(aData, 3);
  3588. dec(aWidth);
  3589. end;
  3590. end;
  3591. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3592. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3593. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3594. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  3595. begin
  3596. result := TFormatDescriptor.Get(Format);
  3597. end;
  3598. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3599. function TglBitmap.GetWidth: Integer;
  3600. begin
  3601. if (ffX in fDimension.Fields) then
  3602. result := fDimension.X
  3603. else
  3604. result := -1;
  3605. end;
  3606. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3607. function TglBitmap.GetHeight: Integer;
  3608. begin
  3609. if (ffY in fDimension.Fields) then
  3610. result := fDimension.Y
  3611. else
  3612. result := -1;
  3613. end;
  3614. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3615. function TglBitmap.GetFileWidth: Integer;
  3616. begin
  3617. result := Max(1, Width);
  3618. end;
  3619. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3620. function TglBitmap.GetFileHeight: Integer;
  3621. begin
  3622. result := Max(1, Height);
  3623. end;
  3624. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3625. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3626. begin
  3627. if fCustomData = aValue then
  3628. exit;
  3629. fCustomData := aValue;
  3630. end;
  3631. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3632. procedure TglBitmap.SetCustomName(const aValue: String);
  3633. begin
  3634. if fCustomName = aValue then
  3635. exit;
  3636. fCustomName := aValue;
  3637. end;
  3638. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3639. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3640. begin
  3641. if fCustomNameW = aValue then
  3642. exit;
  3643. fCustomNameW := aValue;
  3644. end;
  3645. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3646. procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
  3647. begin
  3648. if fFreeDataOnDestroy = aValue then
  3649. exit;
  3650. fFreeDataOnDestroy := aValue;
  3651. end;
  3652. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3653. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3654. begin
  3655. if fDeleteTextureOnFree = aValue then
  3656. exit;
  3657. fDeleteTextureOnFree := aValue;
  3658. end;
  3659. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3660. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3661. begin
  3662. if fFormat = aValue then
  3663. exit;
  3664. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3665. raise EglBitmapUnsupportedFormat.Create(Format);
  3666. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  3667. end;
  3668. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3669. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3670. begin
  3671. if fFreeDataAfterGenTexture = aValue then
  3672. exit;
  3673. fFreeDataAfterGenTexture := aValue;
  3674. end;
  3675. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3676. procedure TglBitmap.SetID(const aValue: Cardinal);
  3677. begin
  3678. if fID = aValue then
  3679. exit;
  3680. fID := aValue;
  3681. end;
  3682. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3683. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3684. begin
  3685. if fMipMap = aValue then
  3686. exit;
  3687. fMipMap := aValue;
  3688. end;
  3689. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3690. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3691. begin
  3692. if fTarget = aValue then
  3693. exit;
  3694. fTarget := aValue;
  3695. end;
  3696. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3697. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3698. var
  3699. MaxAnisotropic: Integer;
  3700. begin
  3701. fAnisotropic := aValue;
  3702. if (ID > 0) then begin
  3703. if GL_EXT_texture_filter_anisotropic then begin
  3704. if fAnisotropic > 0 then begin
  3705. Bind(false);
  3706. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3707. if aValue > MaxAnisotropic then
  3708. fAnisotropic := MaxAnisotropic;
  3709. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3710. end;
  3711. end else begin
  3712. fAnisotropic := 0;
  3713. end;
  3714. end;
  3715. end;
  3716. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3717. procedure TglBitmap.CreateID;
  3718. begin
  3719. if (ID <> 0) then
  3720. glDeleteTextures(1, @fID);
  3721. glGenTextures(1, @fID);
  3722. Bind(false);
  3723. end;
  3724. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3725. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3726. begin
  3727. // Set Up Parameters
  3728. SetWrap(fWrapS, fWrapT, fWrapR);
  3729. SetFilter(fFilterMin, fFilterMag);
  3730. SetAnisotropic(fAnisotropic);
  3731. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3732. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  3733. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3734. // Mip Maps Generation Mode
  3735. aBuildWithGlu := false;
  3736. if (MipMap = mmMipmap) then begin
  3737. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3738. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3739. else
  3740. aBuildWithGlu := true;
  3741. end else if (MipMap = mmMipmapGlu) then
  3742. aBuildWithGlu := true;
  3743. end;
  3744. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3745. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  3746. const aWidth: Integer; const aHeight: Integer);
  3747. var
  3748. s: Single;
  3749. begin
  3750. if (Data <> aData) then begin
  3751. if (Assigned(Data)) then
  3752. FreeMem(Data);
  3753. fData := aData;
  3754. end;
  3755. if not Assigned(fData) then begin
  3756. fPixelSize := 0;
  3757. fRowSize := 0;
  3758. end else begin
  3759. FillChar(fDimension, SizeOf(fDimension), 0);
  3760. if aWidth <> -1 then begin
  3761. fDimension.Fields := fDimension.Fields + [ffX];
  3762. fDimension.X := aWidth;
  3763. end;
  3764. if aHeight <> -1 then begin
  3765. fDimension.Fields := fDimension.Fields + [ffY];
  3766. fDimension.Y := aHeight;
  3767. end;
  3768. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3769. fFormat := aFormat;
  3770. fPixelSize := Ceil(s);
  3771. fRowSize := Ceil(s * aWidth);
  3772. end;
  3773. end;
  3774. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3775. function TglBitmap.FlipHorz: Boolean;
  3776. begin
  3777. result := false;
  3778. end;
  3779. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3780. function TglBitmap.FlipVert: Boolean;
  3781. begin
  3782. result := false;
  3783. end;
  3784. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3785. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3786. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3787. procedure TglBitmap.AfterConstruction;
  3788. begin
  3789. inherited AfterConstruction;
  3790. fID := 0;
  3791. fTarget := 0;
  3792. fIsResident := false;
  3793. fMipMap := glBitmapDefaultMipmap;
  3794. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3795. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3796. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3797. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3798. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3799. end;
  3800. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3801. procedure TglBitmap.BeforeDestruction;
  3802. var
  3803. NewData: PByte;
  3804. begin
  3805. if fFreeDataOnDestroy then begin
  3806. NewData := nil;
  3807. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  3808. end;
  3809. if (fID > 0) and fDeleteTextureOnFree then
  3810. glDeleteTextures(1, @fID);
  3811. inherited BeforeDestruction;
  3812. end;
  3813. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3814. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  3815. var
  3816. TempPos: Integer;
  3817. begin
  3818. if not Assigned(aResType) then begin
  3819. TempPos := Pos('.', aResource);
  3820. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3821. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3822. end;
  3823. end;
  3824. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3825. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3826. var
  3827. fs: TFileStream;
  3828. begin
  3829. if not FileExists(aFilename) then
  3830. raise EglBitmap.Create('file does not exist: ' + aFilename);
  3831. fFilename := aFilename;
  3832. fs := TFileStream.Create(fFilename, fmOpenRead);
  3833. try
  3834. fs.Position := 0;
  3835. LoadFromStream(fs);
  3836. finally
  3837. fs.Free;
  3838. end;
  3839. end;
  3840. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3841. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3842. begin
  3843. {$IFDEF GLB_SUPPORT_PNG_READ}
  3844. if not LoadPNG(aStream) then
  3845. {$ENDIF}
  3846. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3847. if not LoadJPEG(aStream) then
  3848. {$ENDIF}
  3849. if not LoadDDS(aStream) then
  3850. if not LoadTGA(aStream) then
  3851. if not LoadBMP(aStream) then
  3852. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3853. end;
  3854. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3855. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3856. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3857. var
  3858. tmpData: PByte;
  3859. size: Integer;
  3860. begin
  3861. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3862. GetMem(tmpData, size);
  3863. try
  3864. FillChar(tmpData^, size, #$FF);
  3865. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  3866. except
  3867. if Assigned(tmpData) then
  3868. FreeMem(tmpData);
  3869. raise;
  3870. end;
  3871. AddFunc(Self, aFunc, false, aFormat, aArgs);
  3872. end;
  3873. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3874. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  3875. var
  3876. rs: TResourceStream;
  3877. begin
  3878. PrepareResType(aResource, aResType);
  3879. rs := TResourceStream.Create(aInstance, aResource, aResType);
  3880. try
  3881. LoadFromStream(rs);
  3882. finally
  3883. rs.Free;
  3884. end;
  3885. end;
  3886. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3887. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3888. var
  3889. rs: TResourceStream;
  3890. begin
  3891. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  3892. try
  3893. LoadFromStream(rs);
  3894. finally
  3895. rs.Free;
  3896. end;
  3897. end;
  3898. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3899. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3900. var
  3901. fs: TFileStream;
  3902. begin
  3903. fs := TFileStream.Create(aFileName, fmCreate);
  3904. try
  3905. fs.Position := 0;
  3906. SaveToStream(fs, aFileType);
  3907. finally
  3908. fs.Free;
  3909. end;
  3910. end;
  3911. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3912. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3913. begin
  3914. case aFileType of
  3915. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3916. ftPNG: SavePNG(aStream);
  3917. {$ENDIF}
  3918. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3919. ftJPEG: SaveJPEG(aStream);
  3920. {$ENDIF}
  3921. ftDDS: SaveDDS(aStream);
  3922. ftTGA: SaveTGA(aStream);
  3923. ftBMP: SaveBMP(aStream);
  3924. end;
  3925. end;
  3926. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3927. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3928. begin
  3929. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3930. end;
  3931. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3932. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3933. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3934. var
  3935. DestData, TmpData, SourceData: pByte;
  3936. TempHeight, TempWidth: Integer;
  3937. SourceFD, DestFD: TFormatDescriptor;
  3938. SourceMD, DestMD: Pointer;
  3939. FuncRec: TglBitmapFunctionRec;
  3940. begin
  3941. Assert(Assigned(Data));
  3942. Assert(Assigned(aSource));
  3943. Assert(Assigned(aSource.Data));
  3944. result := false;
  3945. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3946. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3947. DestFD := TFormatDescriptor.Get(aFormat);
  3948. if (SourceFD.IsCompressed) then
  3949. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  3950. if (DestFD.IsCompressed) then
  3951. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  3952. // inkompatible Formats so CreateTemp
  3953. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3954. aCreateTemp := true;
  3955. // Values
  3956. TempHeight := Max(1, aSource.Height);
  3957. TempWidth := Max(1, aSource.Width);
  3958. FuncRec.Sender := Self;
  3959. FuncRec.Args := aArgs;
  3960. TmpData := nil;
  3961. if aCreateTemp then begin
  3962. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  3963. DestData := TmpData;
  3964. end else
  3965. DestData := Data;
  3966. try
  3967. SourceFD.PreparePixel(FuncRec.Source);
  3968. DestFD.PreparePixel (FuncRec.Dest);
  3969. SourceMD := SourceFD.CreateMappingData;
  3970. DestMD := DestFD.CreateMappingData;
  3971. FuncRec.Size := aSource.Dimension;
  3972. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3973. try
  3974. SourceData := aSource.Data;
  3975. FuncRec.Position.Y := 0;
  3976. while FuncRec.Position.Y < TempHeight do begin
  3977. FuncRec.Position.X := 0;
  3978. while FuncRec.Position.X < TempWidth do begin
  3979. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3980. aFunc(FuncRec);
  3981. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3982. inc(FuncRec.Position.X);
  3983. end;
  3984. inc(FuncRec.Position.Y);
  3985. end;
  3986. // Updating Image or InternalFormat
  3987. if aCreateTemp then
  3988. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  3989. else if (aFormat <> fFormat) then
  3990. Format := aFormat;
  3991. result := true;
  3992. finally
  3993. SourceFD.FreeMappingData(SourceMD);
  3994. DestFD.FreeMappingData(DestMD);
  3995. end;
  3996. except
  3997. if aCreateTemp and Assigned(TmpData) then
  3998. FreeMem(TmpData);
  3999. raise;
  4000. end;
  4001. end;
  4002. end;
  4003. {$IFDEF GLB_SDL}
  4004. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4005. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  4006. var
  4007. Row, RowSize: Integer;
  4008. SourceData, TmpData: PByte;
  4009. TempDepth: Integer;
  4010. FormatDesc: TFormatDescriptor;
  4011. function GetRowPointer(Row: Integer): pByte;
  4012. begin
  4013. result := aSurface.pixels;
  4014. Inc(result, Row * RowSize);
  4015. end;
  4016. begin
  4017. result := false;
  4018. FormatDesc := TFormatDescriptor.Get(Format);
  4019. if FormatDesc.IsCompressed then
  4020. raise EglBitmapUnsupportedFormat.Create(Format);
  4021. if Assigned(Data) then begin
  4022. case Trunc(FormatDesc.PixelSize) of
  4023. 1: TempDepth := 8;
  4024. 2: TempDepth := 16;
  4025. 3: TempDepth := 24;
  4026. 4: TempDepth := 32;
  4027. else
  4028. raise EglBitmapUnsupportedFormat.Create(Format);
  4029. end;
  4030. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4031. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4032. SourceData := Data;
  4033. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4034. for Row := 0 to FileHeight-1 do begin
  4035. TmpData := GetRowPointer(Row);
  4036. if Assigned(TmpData) then begin
  4037. Move(SourceData^, TmpData^, RowSize);
  4038. inc(SourceData, RowSize);
  4039. end;
  4040. end;
  4041. result := true;
  4042. end;
  4043. end;
  4044. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4045. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4046. var
  4047. pSource, pData, pTempData: PByte;
  4048. Row, RowSize, TempWidth, TempHeight: Integer;
  4049. IntFormat: TglBitmapFormat;
  4050. FormatDesc: TFormatDescriptor;
  4051. function GetRowPointer(Row: Integer): pByte;
  4052. begin
  4053. result := aSurface^.pixels;
  4054. Inc(result, Row * RowSize);
  4055. end;
  4056. begin
  4057. result := false;
  4058. if (Assigned(aSurface)) then begin
  4059. with aSurface^.format^ do begin
  4060. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  4061. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4062. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  4063. break;
  4064. end;
  4065. if (IntFormat = tfEmpty) then
  4066. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  4067. end;
  4068. TempWidth := aSurface^.w;
  4069. TempHeight := aSurface^.h;
  4070. RowSize := FormatDesc.GetSize(TempWidth, 1);
  4071. GetMem(pData, TempHeight * RowSize);
  4072. try
  4073. pTempData := pData;
  4074. for Row := 0 to TempHeight -1 do begin
  4075. pSource := GetRowPointer(Row);
  4076. if (Assigned(pSource)) then begin
  4077. Move(pSource^, pTempData^, RowSize);
  4078. Inc(pTempData, RowSize);
  4079. end;
  4080. end;
  4081. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4082. result := true;
  4083. except
  4084. if Assigned(pData) then
  4085. FreeMem(pData);
  4086. raise;
  4087. end;
  4088. end;
  4089. end;
  4090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4091. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4092. var
  4093. Row, Col, AlphaInterleave: Integer;
  4094. pSource, pDest: PByte;
  4095. function GetRowPointer(Row: Integer): pByte;
  4096. begin
  4097. result := aSurface.pixels;
  4098. Inc(result, Row * Width);
  4099. end;
  4100. begin
  4101. result := false;
  4102. if Assigned(Data) then begin
  4103. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  4104. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4105. AlphaInterleave := 0;
  4106. case Format of
  4107. tfLuminance8Alpha8:
  4108. AlphaInterleave := 1;
  4109. tfBGRA8, tfRGBA8:
  4110. AlphaInterleave := 3;
  4111. end;
  4112. pSource := Data;
  4113. for Row := 0 to Height -1 do begin
  4114. pDest := GetRowPointer(Row);
  4115. if Assigned(pDest) then begin
  4116. for Col := 0 to Width -1 do begin
  4117. Inc(pSource, AlphaInterleave);
  4118. pDest^ := pSource^;
  4119. Inc(pDest);
  4120. Inc(pSource);
  4121. end;
  4122. end;
  4123. end;
  4124. result := true;
  4125. end;
  4126. end;
  4127. end;
  4128. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4129. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4130. var
  4131. bmp: TglBitmap2D;
  4132. begin
  4133. bmp := TglBitmap2D.Create;
  4134. try
  4135. bmp.AssignFromSurface(aSurface);
  4136. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4137. finally
  4138. bmp.Free;
  4139. end;
  4140. end;
  4141. {$ENDIF}
  4142. {$IFDEF GLB_DELPHI}
  4143. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4144. function CreateGrayPalette: HPALETTE;
  4145. var
  4146. Idx: Integer;
  4147. Pal: PLogPalette;
  4148. begin
  4149. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4150. Pal.palVersion := $300;
  4151. Pal.palNumEntries := 256;
  4152. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4153. Pal.palPalEntry[Idx].peRed := Idx;
  4154. Pal.palPalEntry[Idx].peGreen := Idx;
  4155. Pal.palPalEntry[Idx].peBlue := Idx;
  4156. Pal.palPalEntry[Idx].peFlags := 0;
  4157. end;
  4158. Result := CreatePalette(Pal^);
  4159. FreeMem(Pal);
  4160. end;
  4161. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4162. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4163. var
  4164. Row: Integer;
  4165. pSource, pData: PByte;
  4166. begin
  4167. result := false;
  4168. if Assigned(Data) then begin
  4169. if Assigned(aBitmap) then begin
  4170. aBitmap.Width := Width;
  4171. aBitmap.Height := Height;
  4172. case Format of
  4173. tfAlpha8, tfLuminance8: begin
  4174. aBitmap.PixelFormat := pf8bit;
  4175. aBitmap.Palette := CreateGrayPalette;
  4176. end;
  4177. tfRGB5A1:
  4178. aBitmap.PixelFormat := pf15bit;
  4179. tfR5G6B5:
  4180. aBitmap.PixelFormat := pf16bit;
  4181. tfRGB8, tfBGR8:
  4182. aBitmap.PixelFormat := pf24bit;
  4183. tfRGBA8, tfBGRA8:
  4184. aBitmap.PixelFormat := pf32bit;
  4185. else
  4186. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4187. end;
  4188. pSource := Data;
  4189. for Row := 0 to FileHeight -1 do begin
  4190. pData := aBitmap.Scanline[Row];
  4191. Move(pSource^, pData^, fRowSize);
  4192. Inc(pSource, fRowSize);
  4193. if (Format in [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A)
  4194. SwapRGB(pData, FileWidth, Format = tfRGBA8);
  4195. end;
  4196. result := true;
  4197. end;
  4198. end;
  4199. end;
  4200. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4201. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4202. var
  4203. pSource, pData, pTempData: PByte;
  4204. Row, RowSize, TempWidth, TempHeight: Integer;
  4205. IntFormat: TglBitmapFormat;
  4206. begin
  4207. result := false;
  4208. if (Assigned(aBitmap)) then begin
  4209. case aBitmap.PixelFormat of
  4210. pf8bit:
  4211. IntFormat := tfLuminance8;
  4212. pf15bit:
  4213. IntFormat := tfRGB5A1;
  4214. pf16bit:
  4215. IntFormat := tfR5G6B5;
  4216. pf24bit:
  4217. IntFormat := tfBGR8;
  4218. pf32bit:
  4219. IntFormat := tfBGRA8;
  4220. else
  4221. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4222. end;
  4223. TempWidth := aBitmap.Width;
  4224. TempHeight := aBitmap.Height;
  4225. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4226. GetMem(pData, TempHeight * RowSize);
  4227. try
  4228. pTempData := pData;
  4229. for Row := 0 to TempHeight -1 do begin
  4230. pSource := aBitmap.Scanline[Row];
  4231. if (Assigned(pSource)) then begin
  4232. Move(pSource^, pTempData^, RowSize);
  4233. Inc(pTempData, RowSize);
  4234. end;
  4235. end;
  4236. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4237. result := true;
  4238. except
  4239. if Assigned(pData) then
  4240. FreeMem(pData);
  4241. raise;
  4242. end;
  4243. end;
  4244. end;
  4245. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4246. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4247. var
  4248. Row, Col, AlphaInterleave: Integer;
  4249. pSource, pDest: PByte;
  4250. begin
  4251. result := false;
  4252. if Assigned(Data) then begin
  4253. if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
  4254. if Assigned(aBitmap) then begin
  4255. aBitmap.PixelFormat := pf8bit;
  4256. aBitmap.Palette := CreateGrayPalette;
  4257. aBitmap.Width := Width;
  4258. aBitmap.Height := Height;
  4259. case Format of
  4260. tfLuminance8Alpha8:
  4261. AlphaInterleave := 1;
  4262. tfRGBA8, tfBGRA8:
  4263. AlphaInterleave := 3;
  4264. else
  4265. AlphaInterleave := 0;
  4266. end;
  4267. // Copy Data
  4268. pSource := Data;
  4269. for Row := 0 to Height -1 do begin
  4270. pDest := aBitmap.Scanline[Row];
  4271. if Assigned(pDest) then begin
  4272. for Col := 0 to Width -1 do begin
  4273. Inc(pSource, AlphaInterleave);
  4274. pDest^ := pSource^;
  4275. Inc(pDest);
  4276. Inc(pSource);
  4277. end;
  4278. end;
  4279. end;
  4280. result := true;
  4281. end;
  4282. end;
  4283. end;
  4284. end;
  4285. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4286. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4287. var
  4288. tex: TglBitmap2D;
  4289. begin
  4290. tex := TglBitmap2D.Create;
  4291. try
  4292. tex.AssignFromBitmap(ABitmap);
  4293. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4294. finally
  4295. tex.Free;
  4296. end;
  4297. end;
  4298. {$ENDIF}
  4299. {$IFDEF GLB_LAZARUS}
  4300. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4301. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4302. var
  4303. rid: TRawImageDescription;
  4304. FormatDesc: TFormatDescriptor;
  4305. begin
  4306. result := false;
  4307. if not Assigned(aImage) or (Format = tfEmpty) then
  4308. exit;
  4309. FormatDesc := TFormatDescriptor.Get(Format);
  4310. if FormatDesc.IsCompressed then
  4311. exit;
  4312. FillChar(rid{%H-}, SizeOf(rid), 0);
  4313. if (Format in [
  4314. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  4315. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  4316. tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
  4317. rid.Format := ricfGray
  4318. else
  4319. rid.Format := ricfRGBA;
  4320. rid.Width := Width;
  4321. rid.Height := Height;
  4322. rid.Depth := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
  4323. rid.BitOrder := riboBitsInOrder;
  4324. rid.ByteOrder := riboLSBFirst;
  4325. rid.LineOrder := riloTopToBottom;
  4326. rid.LineEnd := rileTight;
  4327. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4328. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4329. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4330. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4331. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4332. rid.RedShift := FormatDesc.Shift.r;
  4333. rid.GreenShift := FormatDesc.Shift.g;
  4334. rid.BlueShift := FormatDesc.Shift.b;
  4335. rid.AlphaShift := FormatDesc.Shift.a;
  4336. rid.MaskBitsPerPixel := 0;
  4337. rid.PaletteColorCount := 0;
  4338. aImage.DataDescription := rid;
  4339. aImage.CreateData;
  4340. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4341. result := true;
  4342. end;
  4343. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4344. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4345. var
  4346. f: TglBitmapFormat;
  4347. FormatDesc: TFormatDescriptor;
  4348. ImageData: PByte;
  4349. ImageSize: Integer;
  4350. CanCopy: Boolean;
  4351. procedure CopyConvert;
  4352. var
  4353. bfFormat: TbmpBitfieldFormat;
  4354. pSourceLine, pDestLine: PByte;
  4355. pSourceMD, pDestMD: Pointer;
  4356. x, y: Cardinal;
  4357. pixel: TglBitmapPixelData;
  4358. begin
  4359. bfFormat := TbmpBitfieldFormat.Create;
  4360. with aImage.DataDescription do begin
  4361. bfFormat.RedMask := ((1 shl RedPrec) - 1) shl RedShift;
  4362. bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
  4363. bfFormat.BlueMask := ((1 shl BluePrec) - 1) shl BlueShift;
  4364. bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
  4365. bfFormat.PixelSize := BitsPerPixel / 8;
  4366. end;
  4367. pSourceMD := bfFormat.CreateMappingData;
  4368. pDestMD := FormatDesc.CreateMappingData;
  4369. try
  4370. for y := 0 to aImage.Height-1 do begin
  4371. pSourceLine := aImage.PixelData + y * aImage.DataDescription.BytesPerLine;
  4372. pDestLine := ImageData + y * Round(FormatDesc.PixelSize * aImage.Width);
  4373. for x := 0 to aImage.Width-1 do begin
  4374. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  4375. FormatDesc.Map(pixel, pDestLine, pDestMD);
  4376. end;
  4377. end;
  4378. finally
  4379. FormatDesc.FreeMappingData(pDestMD);
  4380. bfFormat.FreeMappingData(pSourceMD);
  4381. bfFormat.Free;
  4382. end;
  4383. end;
  4384. begin
  4385. result := false;
  4386. if not Assigned(aImage) then
  4387. exit;
  4388. for f := High(f) downto Low(f) do begin
  4389. FormatDesc := TFormatDescriptor.Get(f);
  4390. with aImage.DataDescription do
  4391. if FormatDesc.MaskMatch(
  4392. (QWord(1 shl RedPrec )-1) shl RedShift,
  4393. (QWord(1 shl GreenPrec)-1) shl GreenShift,
  4394. (QWord(1 shl BluePrec )-1) shl BlueShift,
  4395. (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
  4396. break;
  4397. end;
  4398. if (f = tfEmpty) then
  4399. exit;
  4400. CanCopy :=
  4401. (Round(FormatDesc.PixelSize * 8) = aImage.DataDescription.Depth) and
  4402. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  4403. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4404. ImageData := GetMem(ImageSize);
  4405. try
  4406. if CanCopy then
  4407. Move(aImage.PixelData^, ImageData^, ImageSize)
  4408. else
  4409. CopyConvert;
  4410. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4411. except
  4412. if Assigned(ImageData) then
  4413. FreeMem(ImageData);
  4414. raise;
  4415. end;
  4416. result := true;
  4417. end;
  4418. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4419. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4420. var
  4421. rid: TRawImageDescription;
  4422. FormatDesc: TFormatDescriptor;
  4423. Pixel: TglBitmapPixelData;
  4424. x, y: Integer;
  4425. srcMD: Pointer;
  4426. src, dst: PByte;
  4427. begin
  4428. result := false;
  4429. if not Assigned(aImage) or (Format = tfEmpty) then
  4430. exit;
  4431. FormatDesc := TFormatDescriptor.Get(Format);
  4432. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4433. exit;
  4434. FillChar(rid{%H-}, SizeOf(rid), 0);
  4435. rid.Format := ricfGray;
  4436. rid.Width := Width;
  4437. rid.Height := Height;
  4438. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4439. rid.BitOrder := riboBitsInOrder;
  4440. rid.ByteOrder := riboLSBFirst;
  4441. rid.LineOrder := riloTopToBottom;
  4442. rid.LineEnd := rileTight;
  4443. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4444. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4445. rid.GreenPrec := 0;
  4446. rid.BluePrec := 0;
  4447. rid.AlphaPrec := 0;
  4448. rid.RedShift := 0;
  4449. rid.GreenShift := 0;
  4450. rid.BlueShift := 0;
  4451. rid.AlphaShift := 0;
  4452. rid.MaskBitsPerPixel := 0;
  4453. rid.PaletteColorCount := 0;
  4454. aImage.DataDescription := rid;
  4455. aImage.CreateData;
  4456. srcMD := FormatDesc.CreateMappingData;
  4457. try
  4458. FormatDesc.PreparePixel(Pixel);
  4459. src := Data;
  4460. dst := aImage.PixelData;
  4461. for y := 0 to Height-1 do
  4462. for x := 0 to Width-1 do begin
  4463. FormatDesc.Unmap(src, Pixel, srcMD);
  4464. case rid.BitsPerPixel of
  4465. 8: begin
  4466. dst^ := Pixel.Data.a;
  4467. inc(dst);
  4468. end;
  4469. 16: begin
  4470. PWord(dst)^ := Pixel.Data.a;
  4471. inc(dst, 2);
  4472. end;
  4473. 24: begin
  4474. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4475. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4476. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4477. inc(dst, 3);
  4478. end;
  4479. 32: begin
  4480. PCardinal(dst)^ := Pixel.Data.a;
  4481. inc(dst, 4);
  4482. end;
  4483. else
  4484. raise EglBitmapUnsupportedFormat.Create(Format);
  4485. end;
  4486. end;
  4487. finally
  4488. FormatDesc.FreeMappingData(srcMD);
  4489. end;
  4490. result := true;
  4491. end;
  4492. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4493. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4494. var
  4495. tex: TglBitmap2D;
  4496. begin
  4497. tex := TglBitmap2D.Create;
  4498. try
  4499. tex.AssignFromLazIntfImage(aImage);
  4500. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4501. finally
  4502. tex.Free;
  4503. end;
  4504. end;
  4505. {$ENDIF}
  4506. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4507. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4508. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4509. var
  4510. rs: TResourceStream;
  4511. begin
  4512. PrepareResType(aResource, aResType);
  4513. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4514. try
  4515. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4516. finally
  4517. rs.Free;
  4518. end;
  4519. end;
  4520. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4521. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4522. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4523. var
  4524. rs: TResourceStream;
  4525. begin
  4526. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4527. try
  4528. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4529. finally
  4530. rs.Free;
  4531. end;
  4532. end;
  4533. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4534. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4535. begin
  4536. if TFormatDescriptor.Get(Format).IsCompressed then
  4537. raise EglBitmapUnsupportedFormat.Create(Format);
  4538. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4539. end;
  4540. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4541. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4542. var
  4543. FS: TFileStream;
  4544. begin
  4545. FS := TFileStream.Create(aFileName, fmOpenRead);
  4546. try
  4547. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4548. finally
  4549. FS.Free;
  4550. end;
  4551. end;
  4552. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4553. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4554. var
  4555. tex: TglBitmap2D;
  4556. begin
  4557. tex := TglBitmap2D.Create(aStream);
  4558. try
  4559. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4560. finally
  4561. tex.Free;
  4562. end;
  4563. end;
  4564. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4565. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4566. var
  4567. DestData, DestData2, SourceData: pByte;
  4568. TempHeight, TempWidth: Integer;
  4569. SourceFD, DestFD: TFormatDescriptor;
  4570. SourceMD, DestMD, DestMD2: Pointer;
  4571. FuncRec: TglBitmapFunctionRec;
  4572. begin
  4573. result := false;
  4574. Assert(Assigned(Data));
  4575. Assert(Assigned(aBitmap));
  4576. Assert(Assigned(aBitmap.Data));
  4577. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4578. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4579. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4580. DestFD := TFormatDescriptor.Get(Format);
  4581. if not Assigned(aFunc) then begin
  4582. aFunc := glBitmapAlphaFunc;
  4583. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4584. end else
  4585. FuncRec.Args := aArgs;
  4586. // Values
  4587. TempHeight := aBitmap.FileHeight;
  4588. TempWidth := aBitmap.FileWidth;
  4589. FuncRec.Sender := Self;
  4590. FuncRec.Size := Dimension;
  4591. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4592. DestData := Data;
  4593. DestData2 := Data;
  4594. SourceData := aBitmap.Data;
  4595. // Mapping
  4596. SourceFD.PreparePixel(FuncRec.Source);
  4597. DestFD.PreparePixel (FuncRec.Dest);
  4598. SourceMD := SourceFD.CreateMappingData;
  4599. DestMD := DestFD.CreateMappingData;
  4600. DestMD2 := DestFD.CreateMappingData;
  4601. try
  4602. FuncRec.Position.Y := 0;
  4603. while FuncRec.Position.Y < TempHeight do begin
  4604. FuncRec.Position.X := 0;
  4605. while FuncRec.Position.X < TempWidth do begin
  4606. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4607. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4608. aFunc(FuncRec);
  4609. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4610. inc(FuncRec.Position.X);
  4611. end;
  4612. inc(FuncRec.Position.Y);
  4613. end;
  4614. finally
  4615. SourceFD.FreeMappingData(SourceMD);
  4616. DestFD.FreeMappingData(DestMD);
  4617. DestFD.FreeMappingData(DestMD2);
  4618. end;
  4619. end;
  4620. end;
  4621. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4622. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4623. begin
  4624. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4625. end;
  4626. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4627. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4628. var
  4629. PixelData: TglBitmapPixelData;
  4630. begin
  4631. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4632. result := AddAlphaFromColorKeyFloat(
  4633. aRed / PixelData.Range.r,
  4634. aGreen / PixelData.Range.g,
  4635. aBlue / PixelData.Range.b,
  4636. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4637. end;
  4638. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4639. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4640. var
  4641. values: array[0..2] of Single;
  4642. tmp: Cardinal;
  4643. i: Integer;
  4644. PixelData: TglBitmapPixelData;
  4645. begin
  4646. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4647. with PixelData do begin
  4648. values[0] := aRed;
  4649. values[1] := aGreen;
  4650. values[2] := aBlue;
  4651. for i := 0 to 2 do begin
  4652. tmp := Trunc(Range.arr[i] * aDeviation);
  4653. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4654. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4655. end;
  4656. Data.a := 0;
  4657. Range.a := 0;
  4658. end;
  4659. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4660. end;
  4661. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4662. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4663. begin
  4664. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4665. end;
  4666. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4667. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4668. var
  4669. PixelData: TglBitmapPixelData;
  4670. begin
  4671. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4672. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4673. end;
  4674. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4675. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4676. var
  4677. PixelData: TglBitmapPixelData;
  4678. begin
  4679. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4680. with PixelData do
  4681. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4682. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4683. end;
  4684. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4685. function TglBitmap.RemoveAlpha: Boolean;
  4686. var
  4687. FormatDesc: TFormatDescriptor;
  4688. begin
  4689. result := false;
  4690. FormatDesc := TFormatDescriptor.Get(Format);
  4691. if Assigned(Data) then begin
  4692. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4693. raise EglBitmapUnsupportedFormat.Create(Format);
  4694. result := ConvertTo(FormatDesc.WithoutAlpha);
  4695. end;
  4696. end;
  4697. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4698. function TglBitmap.Clone: TglBitmap;
  4699. var
  4700. Temp: TglBitmap;
  4701. TempPtr: PByte;
  4702. Size: Integer;
  4703. begin
  4704. Temp := (ClassType.Create as TglBitmap);
  4705. try
  4706. // copy texture data if assigned
  4707. if Assigned(Data) then begin
  4708. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4709. GetMem(TempPtr, Size);
  4710. try
  4711. Move(Data^, TempPtr^, Size);
  4712. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4713. except
  4714. if Assigned(TempPtr) then
  4715. FreeMem(TempPtr);
  4716. raise;
  4717. end;
  4718. end else begin
  4719. TempPtr := nil;
  4720. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4721. end;
  4722. // copy properties
  4723. Temp.fID := ID;
  4724. Temp.fTarget := Target;
  4725. Temp.fFormat := Format;
  4726. Temp.fMipMap := MipMap;
  4727. Temp.fAnisotropic := Anisotropic;
  4728. Temp.fBorderColor := fBorderColor;
  4729. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4730. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4731. Temp.fFilterMin := fFilterMin;
  4732. Temp.fFilterMag := fFilterMag;
  4733. Temp.fWrapS := fWrapS;
  4734. Temp.fWrapT := fWrapT;
  4735. Temp.fWrapR := fWrapR;
  4736. Temp.fFilename := fFilename;
  4737. Temp.fCustomName := fCustomName;
  4738. Temp.fCustomNameW := fCustomNameW;
  4739. Temp.fCustomData := fCustomData;
  4740. result := Temp;
  4741. except
  4742. FreeAndNil(Temp);
  4743. raise;
  4744. end;
  4745. end;
  4746. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4747. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4748. var
  4749. SourceFD, DestFD: TFormatDescriptor;
  4750. SourcePD, DestPD: TglBitmapPixelData;
  4751. ShiftData: TShiftData;
  4752. function CanCopyDirect: Boolean;
  4753. begin
  4754. result :=
  4755. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4756. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4757. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4758. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4759. end;
  4760. function CanShift: Boolean;
  4761. begin
  4762. result :=
  4763. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4764. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4765. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4766. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4767. end;
  4768. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4769. begin
  4770. result := 0;
  4771. while (aSource > aDest) and (aSource > 0) do begin
  4772. inc(result);
  4773. aSource := aSource shr 1;
  4774. end;
  4775. end;
  4776. begin
  4777. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4778. SourceFD := TFormatDescriptor.Get(Format);
  4779. DestFD := TFormatDescriptor.Get(aFormat);
  4780. SourceFD.PreparePixel(SourcePD);
  4781. DestFD.PreparePixel (DestPD);
  4782. if CanCopyDirect then
  4783. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4784. else if CanShift then begin
  4785. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4786. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4787. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4788. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4789. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4790. end else
  4791. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4792. end else
  4793. result := true;
  4794. end;
  4795. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4796. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4797. begin
  4798. if aUseRGB or aUseAlpha then
  4799. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4800. ((Byte(aUseAlpha) and 1) shl 1) or
  4801. (Byte(aUseRGB) and 1) ));
  4802. end;
  4803. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4804. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4805. begin
  4806. fBorderColor[0] := aRed;
  4807. fBorderColor[1] := aGreen;
  4808. fBorderColor[2] := aBlue;
  4809. fBorderColor[3] := aAlpha;
  4810. if (ID > 0) then begin
  4811. Bind(false);
  4812. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4813. end;
  4814. end;
  4815. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4816. procedure TglBitmap.FreeData;
  4817. var
  4818. TempPtr: PByte;
  4819. begin
  4820. TempPtr := nil;
  4821. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  4822. end;
  4823. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4824. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4825. const aAlpha: Byte);
  4826. begin
  4827. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4828. end;
  4829. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4830. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4831. var
  4832. PixelData: TglBitmapPixelData;
  4833. begin
  4834. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4835. FillWithColorFloat(
  4836. aRed / PixelData.Range.r,
  4837. aGreen / PixelData.Range.g,
  4838. aBlue / PixelData.Range.b,
  4839. aAlpha / PixelData.Range.a);
  4840. end;
  4841. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4842. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4843. var
  4844. PixelData: TglBitmapPixelData;
  4845. begin
  4846. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4847. with PixelData do begin
  4848. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4849. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4850. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4851. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4852. end;
  4853. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4854. end;
  4855. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4856. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  4857. begin
  4858. //check MIN filter
  4859. case aMin of
  4860. GL_NEAREST:
  4861. fFilterMin := GL_NEAREST;
  4862. GL_LINEAR:
  4863. fFilterMin := GL_LINEAR;
  4864. GL_NEAREST_MIPMAP_NEAREST:
  4865. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4866. GL_LINEAR_MIPMAP_NEAREST:
  4867. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4868. GL_NEAREST_MIPMAP_LINEAR:
  4869. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4870. GL_LINEAR_MIPMAP_LINEAR:
  4871. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4872. else
  4873. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  4874. end;
  4875. //check MAG filter
  4876. case aMag of
  4877. GL_NEAREST:
  4878. fFilterMag := GL_NEAREST;
  4879. GL_LINEAR:
  4880. fFilterMag := GL_LINEAR;
  4881. else
  4882. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  4883. end;
  4884. //apply filter
  4885. if (ID > 0) then begin
  4886. Bind(false);
  4887. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4888. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4889. case fFilterMin of
  4890. GL_NEAREST, GL_LINEAR:
  4891. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4892. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4893. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4894. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4895. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4896. end;
  4897. end else
  4898. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4899. end;
  4900. end;
  4901. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4902. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  4903. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4904. begin
  4905. case aValue of
  4906. GL_CLAMP:
  4907. aTarget := GL_CLAMP;
  4908. GL_REPEAT:
  4909. aTarget := GL_REPEAT;
  4910. GL_CLAMP_TO_EDGE: begin
  4911. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4912. aTarget := GL_CLAMP_TO_EDGE
  4913. else
  4914. aTarget := GL_CLAMP;
  4915. end;
  4916. GL_CLAMP_TO_BORDER: begin
  4917. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4918. aTarget := GL_CLAMP_TO_BORDER
  4919. else
  4920. aTarget := GL_CLAMP;
  4921. end;
  4922. GL_MIRRORED_REPEAT: begin
  4923. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4924. aTarget := GL_MIRRORED_REPEAT
  4925. else
  4926. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4927. end;
  4928. else
  4929. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  4930. end;
  4931. end;
  4932. begin
  4933. CheckAndSetWrap(S, fWrapS);
  4934. CheckAndSetWrap(T, fWrapT);
  4935. CheckAndSetWrap(R, fWrapR);
  4936. if (ID > 0) then begin
  4937. Bind(false);
  4938. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4939. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4940. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4941. end;
  4942. end;
  4943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4944. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  4945. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  4946. begin
  4947. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  4948. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  4949. fSwizzle[aIndex] := aValue
  4950. else
  4951. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  4952. end;
  4953. begin
  4954. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4955. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  4956. CheckAndSetValue(r, 0);
  4957. CheckAndSetValue(g, 1);
  4958. CheckAndSetValue(b, 2);
  4959. CheckAndSetValue(a, 3);
  4960. if (ID > 0) then begin
  4961. Bind(false);
  4962. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  4963. end;
  4964. end;
  4965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4966. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4967. begin
  4968. if aEnableTextureUnit then
  4969. glEnable(Target);
  4970. if (ID > 0) then
  4971. glBindTexture(Target, ID);
  4972. end;
  4973. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4974. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4975. begin
  4976. if aDisableTextureUnit then
  4977. glDisable(Target);
  4978. glBindTexture(Target, 0);
  4979. end;
  4980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4981. constructor TglBitmap.Create;
  4982. begin
  4983. if (ClassType = TglBitmap) then
  4984. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4985. {$IFDEF GLB_NATIVE_OGL}
  4986. glbReadOpenGLExtensions;
  4987. {$ENDIF}
  4988. inherited Create;
  4989. fFormat := glBitmapGetDefaultFormat;
  4990. fFreeDataOnDestroy := true;
  4991. end;
  4992. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4993. constructor TglBitmap.Create(const aFileName: String);
  4994. begin
  4995. Create;
  4996. LoadFromFile(aFileName);
  4997. end;
  4998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4999. constructor TglBitmap.Create(const aStream: TStream);
  5000. begin
  5001. Create;
  5002. LoadFromStream(aStream);
  5003. end;
  5004. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5005. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
  5006. var
  5007. ImageSize: Integer;
  5008. begin
  5009. Create;
  5010. if not Assigned(aData) then begin
  5011. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5012. GetMem(aData, ImageSize);
  5013. try
  5014. FillChar(aData^, ImageSize, #$FF);
  5015. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5016. except
  5017. if Assigned(aData) then
  5018. FreeMem(aData);
  5019. raise;
  5020. end;
  5021. end else begin
  5022. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5023. fFreeDataOnDestroy := false;
  5024. end;
  5025. end;
  5026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5027. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5028. begin
  5029. Create;
  5030. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  5031. end;
  5032. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5033. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  5034. begin
  5035. Create;
  5036. LoadFromResource(aInstance, aResource, aResType);
  5037. end;
  5038. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5039. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5040. begin
  5041. Create;
  5042. LoadFromResourceID(aInstance, aResourceID, aResType);
  5043. end;
  5044. {$IFDEF GLB_SUPPORT_PNG_READ}
  5045. {$IF DEFINED(GLB_LAZ_PNG)}
  5046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5047. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5048. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5049. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5050. const
  5051. MAGIC_LEN = 8;
  5052. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  5053. var
  5054. reader: TLazReaderPNG;
  5055. intf: TLazIntfImage;
  5056. StreamPos: Int64;
  5057. magic: String[MAGIC_LEN];
  5058. begin
  5059. result := true;
  5060. StreamPos := aStream.Position;
  5061. SetLength(magic, MAGIC_LEN);
  5062. aStream.Read(magic[1], MAGIC_LEN);
  5063. aStream.Position := StreamPos;
  5064. if (magic <> PNG_MAGIC) then begin
  5065. result := false;
  5066. exit;
  5067. end;
  5068. intf := TLazIntfImage.Create(0, 0);
  5069. reader := TLazReaderPNG.Create;
  5070. try try
  5071. reader.UpdateDescription := true;
  5072. reader.ImageRead(aStream, intf);
  5073. AssignFromLazIntfImage(intf);
  5074. except
  5075. result := false;
  5076. aStream.Position := StreamPos;
  5077. exit;
  5078. end;
  5079. finally
  5080. reader.Free;
  5081. intf.Free;
  5082. end;
  5083. end;
  5084. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5085. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5086. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5087. var
  5088. Surface: PSDL_Surface;
  5089. RWops: PSDL_RWops;
  5090. begin
  5091. result := false;
  5092. RWops := glBitmapCreateRWops(aStream);
  5093. try
  5094. if IMG_isPNG(RWops) > 0 then begin
  5095. Surface := IMG_LoadPNG_RW(RWops);
  5096. try
  5097. AssignFromSurface(Surface);
  5098. result := true;
  5099. finally
  5100. SDL_FreeSurface(Surface);
  5101. end;
  5102. end;
  5103. finally
  5104. SDL_FreeRW(RWops);
  5105. end;
  5106. end;
  5107. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5108. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5109. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5110. begin
  5111. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5112. end;
  5113. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5114. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5115. var
  5116. StreamPos: Int64;
  5117. signature: array [0..7] of byte;
  5118. png: png_structp;
  5119. png_info: png_infop;
  5120. TempHeight, TempWidth: Integer;
  5121. Format: TglBitmapFormat;
  5122. png_data: pByte;
  5123. png_rows: array of pByte;
  5124. Row, LineSize: Integer;
  5125. begin
  5126. result := false;
  5127. if not init_libPNG then
  5128. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5129. try
  5130. // signature
  5131. StreamPos := aStream.Position;
  5132. aStream.Read(signature{%H-}, 8);
  5133. aStream.Position := StreamPos;
  5134. if png_check_sig(@signature, 8) <> 0 then begin
  5135. // png read struct
  5136. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5137. if png = nil then
  5138. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5139. // png info
  5140. png_info := png_create_info_struct(png);
  5141. if png_info = nil then begin
  5142. png_destroy_read_struct(@png, nil, nil);
  5143. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5144. end;
  5145. // set read callback
  5146. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5147. // read informations
  5148. png_read_info(png, png_info);
  5149. // size
  5150. TempHeight := png_get_image_height(png, png_info);
  5151. TempWidth := png_get_image_width(png, png_info);
  5152. // format
  5153. case png_get_color_type(png, png_info) of
  5154. PNG_COLOR_TYPE_GRAY:
  5155. Format := tfLuminance8;
  5156. PNG_COLOR_TYPE_GRAY_ALPHA:
  5157. Format := tfLuminance8Alpha8;
  5158. PNG_COLOR_TYPE_RGB:
  5159. Format := tfRGB8;
  5160. PNG_COLOR_TYPE_RGB_ALPHA:
  5161. Format := tfRGBA8;
  5162. else
  5163. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5164. end;
  5165. // cut upper 8 bit from 16 bit formats
  5166. if png_get_bit_depth(png, png_info) > 8 then
  5167. png_set_strip_16(png);
  5168. // expand bitdepth smaller than 8
  5169. if png_get_bit_depth(png, png_info) < 8 then
  5170. png_set_expand(png);
  5171. // allocating mem for scanlines
  5172. LineSize := png_get_rowbytes(png, png_info);
  5173. GetMem(png_data, TempHeight * LineSize);
  5174. try
  5175. SetLength(png_rows, TempHeight);
  5176. for Row := Low(png_rows) to High(png_rows) do begin
  5177. png_rows[Row] := png_data;
  5178. Inc(png_rows[Row], Row * LineSize);
  5179. end;
  5180. // read complete image into scanlines
  5181. png_read_image(png, @png_rows[0]);
  5182. // read end
  5183. png_read_end(png, png_info);
  5184. // destroy read struct
  5185. png_destroy_read_struct(@png, @png_info, nil);
  5186. SetLength(png_rows, 0);
  5187. // set new data
  5188. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5189. result := true;
  5190. except
  5191. if Assigned(png_data) then
  5192. FreeMem(png_data);
  5193. raise;
  5194. end;
  5195. end;
  5196. finally
  5197. quit_libPNG;
  5198. end;
  5199. end;
  5200. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5201. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5202. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5203. var
  5204. StreamPos: Int64;
  5205. Png: TPNGObject;
  5206. Header: String[8];
  5207. Row, Col, PixSize, LineSize: Integer;
  5208. NewImage, pSource, pDest, pAlpha: pByte;
  5209. PngFormat: TglBitmapFormat;
  5210. FormatDesc: TFormatDescriptor;
  5211. const
  5212. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5213. begin
  5214. result := false;
  5215. StreamPos := aStream.Position;
  5216. aStream.Read(Header[0], SizeOf(Header));
  5217. aStream.Position := StreamPos;
  5218. {Test if the header matches}
  5219. if Header = PngHeader then begin
  5220. Png := TPNGObject.Create;
  5221. try
  5222. Png.LoadFromStream(aStream);
  5223. case Png.Header.ColorType of
  5224. COLOR_GRAYSCALE:
  5225. PngFormat := tfLuminance8;
  5226. COLOR_GRAYSCALEALPHA:
  5227. PngFormat := tfLuminance8Alpha8;
  5228. COLOR_RGB:
  5229. PngFormat := tfBGR8;
  5230. COLOR_RGBALPHA:
  5231. PngFormat := tfBGRA8;
  5232. else
  5233. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5234. end;
  5235. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5236. PixSize := Round(FormatDesc.PixelSize);
  5237. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5238. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5239. try
  5240. pDest := NewImage;
  5241. case Png.Header.ColorType of
  5242. COLOR_RGB, COLOR_GRAYSCALE:
  5243. begin
  5244. for Row := 0 to Png.Height -1 do begin
  5245. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5246. Inc(pDest, LineSize);
  5247. end;
  5248. end;
  5249. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5250. begin
  5251. PixSize := PixSize -1;
  5252. for Row := 0 to Png.Height -1 do begin
  5253. pSource := Png.Scanline[Row];
  5254. pAlpha := pByte(Png.AlphaScanline[Row]);
  5255. for Col := 0 to Png.Width -1 do begin
  5256. Move (pSource^, pDest^, PixSize);
  5257. Inc(pSource, PixSize);
  5258. Inc(pDest, PixSize);
  5259. pDest^ := pAlpha^;
  5260. inc(pAlpha);
  5261. Inc(pDest);
  5262. end;
  5263. end;
  5264. end;
  5265. else
  5266. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5267. end;
  5268. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5269. result := true;
  5270. except
  5271. if Assigned(NewImage) then
  5272. FreeMem(NewImage);
  5273. raise;
  5274. end;
  5275. finally
  5276. Png.Free;
  5277. end;
  5278. end;
  5279. end;
  5280. {$IFEND}
  5281. {$ENDIF}
  5282. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5283. {$IFDEF GLB_LIB_PNG}
  5284. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5285. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5286. begin
  5287. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5288. end;
  5289. {$ENDIF}
  5290. {$IF DEFINED(GLB_LAZ_PNG)}
  5291. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5292. procedure TglBitmap.SavePNG(const aStream: TStream);
  5293. var
  5294. png: TPortableNetworkGraphic;
  5295. intf: TLazIntfImage;
  5296. raw: TRawImage;
  5297. begin
  5298. png := TPortableNetworkGraphic.Create;
  5299. intf := TLazIntfImage.Create(0, 0);
  5300. try
  5301. if not AssignToLazIntfImage(intf) then
  5302. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5303. intf.GetRawImage(raw);
  5304. png.LoadFromRawImage(raw, false);
  5305. png.SaveToStream(aStream);
  5306. finally
  5307. png.Free;
  5308. intf.Free;
  5309. end;
  5310. end;
  5311. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5312. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5313. procedure TglBitmap.SavePNG(const aStream: TStream);
  5314. var
  5315. png: png_structp;
  5316. png_info: png_infop;
  5317. png_rows: array of pByte;
  5318. LineSize: Integer;
  5319. ColorType: Integer;
  5320. Row: Integer;
  5321. FormatDesc: TFormatDescriptor;
  5322. begin
  5323. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5324. raise EglBitmapUnsupportedFormat.Create(Format);
  5325. if not init_libPNG then
  5326. raise Exception.Create('unable to initialize libPNG.');
  5327. try
  5328. case Format of
  5329. tfAlpha8, tfLuminance8:
  5330. ColorType := PNG_COLOR_TYPE_GRAY;
  5331. tfLuminance8Alpha8:
  5332. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5333. tfBGR8, tfRGB8:
  5334. ColorType := PNG_COLOR_TYPE_RGB;
  5335. tfBGRA8, tfRGBA8:
  5336. ColorType := PNG_COLOR_TYPE_RGBA;
  5337. else
  5338. raise EglBitmapUnsupportedFormat.Create(Format);
  5339. end;
  5340. FormatDesc := TFormatDescriptor.Get(Format);
  5341. LineSize := FormatDesc.GetSize(Width, 1);
  5342. // creating array for scanline
  5343. SetLength(png_rows, Height);
  5344. try
  5345. for Row := 0 to Height - 1 do begin
  5346. png_rows[Row] := Data;
  5347. Inc(png_rows[Row], Row * LineSize)
  5348. end;
  5349. // write struct
  5350. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5351. if png = nil then
  5352. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5353. // create png info
  5354. png_info := png_create_info_struct(png);
  5355. if png_info = nil then begin
  5356. png_destroy_write_struct(@png, nil);
  5357. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5358. end;
  5359. // set read callback
  5360. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5361. // set compression
  5362. png_set_compression_level(png, 6);
  5363. if Format in [tfBGR8, tfBGRA8] then
  5364. png_set_bgr(png);
  5365. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5366. png_write_info(png, png_info);
  5367. png_write_image(png, @png_rows[0]);
  5368. png_write_end(png, png_info);
  5369. png_destroy_write_struct(@png, @png_info);
  5370. finally
  5371. SetLength(png_rows, 0);
  5372. end;
  5373. finally
  5374. quit_libPNG;
  5375. end;
  5376. end;
  5377. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5378. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5379. procedure TglBitmap.SavePNG(const aStream: TStream);
  5380. var
  5381. Png: TPNGObject;
  5382. pSource, pDest: pByte;
  5383. X, Y, PixSize: Integer;
  5384. ColorType: Cardinal;
  5385. Alpha: Boolean;
  5386. pTemp: pByte;
  5387. Temp: Byte;
  5388. begin
  5389. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5390. raise EglBitmapUnsupportedFormat.Create(Format);
  5391. case Format of
  5392. tfAlpha8, tfLuminance8: begin
  5393. ColorType := COLOR_GRAYSCALE;
  5394. PixSize := 1;
  5395. Alpha := false;
  5396. end;
  5397. tfLuminance8Alpha8: begin
  5398. ColorType := COLOR_GRAYSCALEALPHA;
  5399. PixSize := 1;
  5400. Alpha := true;
  5401. end;
  5402. tfBGR8, tfRGB8: begin
  5403. ColorType := COLOR_RGB;
  5404. PixSize := 3;
  5405. Alpha := false;
  5406. end;
  5407. tfBGRA8, tfRGBA8: begin
  5408. ColorType := COLOR_RGBALPHA;
  5409. PixSize := 3;
  5410. Alpha := true
  5411. end;
  5412. else
  5413. raise EglBitmapUnsupportedFormat.Create(Format);
  5414. end;
  5415. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5416. try
  5417. // Copy ImageData
  5418. pSource := Data;
  5419. for Y := 0 to Height -1 do begin
  5420. pDest := png.ScanLine[Y];
  5421. for X := 0 to Width -1 do begin
  5422. Move(pSource^, pDest^, PixSize);
  5423. Inc(pDest, PixSize);
  5424. Inc(pSource, PixSize);
  5425. if Alpha then begin
  5426. png.AlphaScanline[Y]^[X] := pSource^;
  5427. Inc(pSource);
  5428. end;
  5429. end;
  5430. // convert RGB line to BGR
  5431. if Format in [tfRGB8, tfRGBA8] then begin
  5432. pTemp := png.ScanLine[Y];
  5433. for X := 0 to Width -1 do begin
  5434. Temp := pByteArray(pTemp)^[0];
  5435. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5436. pByteArray(pTemp)^[2] := Temp;
  5437. Inc(pTemp, 3);
  5438. end;
  5439. end;
  5440. end;
  5441. // Save to Stream
  5442. Png.CompressionLevel := 6;
  5443. Png.SaveToStream(aStream);
  5444. finally
  5445. FreeAndNil(Png);
  5446. end;
  5447. end;
  5448. {$IFEND}
  5449. {$ENDIF}
  5450. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5451. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5452. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5453. {$IFDEF GLB_LIB_JPEG}
  5454. type
  5455. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5456. glBitmap_libJPEG_source_mgr = record
  5457. pub: jpeg_source_mgr;
  5458. SrcStream: TStream;
  5459. SrcBuffer: array [1..4096] of byte;
  5460. end;
  5461. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5462. glBitmap_libJPEG_dest_mgr = record
  5463. pub: jpeg_destination_mgr;
  5464. DestStream: TStream;
  5465. DestBuffer: array [1..4096] of byte;
  5466. end;
  5467. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5468. begin
  5469. //DUMMY
  5470. end;
  5471. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5472. begin
  5473. //DUMMY
  5474. end;
  5475. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5476. begin
  5477. //DUMMY
  5478. end;
  5479. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5480. begin
  5481. //DUMMY
  5482. end;
  5483. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5484. begin
  5485. //DUMMY
  5486. end;
  5487. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5488. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5489. var
  5490. src: glBitmap_libJPEG_source_mgr_ptr;
  5491. bytes: integer;
  5492. begin
  5493. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5494. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5495. if (bytes <= 0) then begin
  5496. src^.SrcBuffer[1] := $FF;
  5497. src^.SrcBuffer[2] := JPEG_EOI;
  5498. bytes := 2;
  5499. end;
  5500. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5501. src^.pub.bytes_in_buffer := bytes;
  5502. result := true;
  5503. end;
  5504. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5505. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5506. var
  5507. src: glBitmap_libJPEG_source_mgr_ptr;
  5508. begin
  5509. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5510. if num_bytes > 0 then begin
  5511. // wanted byte isn't in buffer so set stream position and read buffer
  5512. if num_bytes > src^.pub.bytes_in_buffer then begin
  5513. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5514. src^.pub.fill_input_buffer(cinfo);
  5515. end else begin
  5516. // wanted byte is in buffer so only skip
  5517. inc(src^.pub.next_input_byte, num_bytes);
  5518. dec(src^.pub.bytes_in_buffer, num_bytes);
  5519. end;
  5520. end;
  5521. end;
  5522. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5523. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5524. var
  5525. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5526. begin
  5527. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5528. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5529. // write complete buffer
  5530. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5531. // reset buffer
  5532. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5533. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5534. end;
  5535. result := true;
  5536. end;
  5537. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5538. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5539. var
  5540. Idx: Integer;
  5541. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5542. begin
  5543. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5544. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5545. // check for endblock
  5546. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5547. // write endblock
  5548. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5549. // leave
  5550. break;
  5551. end else
  5552. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5553. end;
  5554. end;
  5555. {$ENDIF}
  5556. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5557. {$IF DEFINED(GLB_LAZ_JPEG)}
  5558. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5559. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5560. const
  5561. MAGIC_LEN = 2;
  5562. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  5563. var
  5564. intf: TLazIntfImage;
  5565. reader: TFPReaderJPEG;
  5566. StreamPos: Int64;
  5567. magic: String[MAGIC_LEN];
  5568. begin
  5569. result := true;
  5570. StreamPos := aStream.Position;
  5571. SetLength(magic, MAGIC_LEN);
  5572. aStream.Read(magic[1], MAGIC_LEN);
  5573. aStream.Position := StreamPos;
  5574. if (magic <> JPEG_MAGIC) then begin
  5575. result := false;
  5576. exit;
  5577. end;
  5578. reader := TFPReaderJPEG.Create;
  5579. intf := TLazIntfImage.Create(0, 0);
  5580. try try
  5581. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  5582. reader.ImageRead(aStream, intf);
  5583. AssignFromLazIntfImage(intf);
  5584. except
  5585. result := false;
  5586. aStream.Position := StreamPos;
  5587. exit;
  5588. end;
  5589. finally
  5590. reader.Free;
  5591. intf.Free;
  5592. end;
  5593. end;
  5594. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5595. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5596. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5597. var
  5598. Surface: PSDL_Surface;
  5599. RWops: PSDL_RWops;
  5600. begin
  5601. result := false;
  5602. RWops := glBitmapCreateRWops(aStream);
  5603. try
  5604. if IMG_isJPG(RWops) > 0 then begin
  5605. Surface := IMG_LoadJPG_RW(RWops);
  5606. try
  5607. AssignFromSurface(Surface);
  5608. result := true;
  5609. finally
  5610. SDL_FreeSurface(Surface);
  5611. end;
  5612. end;
  5613. finally
  5614. SDL_FreeRW(RWops);
  5615. end;
  5616. end;
  5617. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5618. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5619. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5620. var
  5621. StreamPos: Int64;
  5622. Temp: array[0..1]of Byte;
  5623. jpeg: jpeg_decompress_struct;
  5624. jpeg_err: jpeg_error_mgr;
  5625. IntFormat: TglBitmapFormat;
  5626. pImage: pByte;
  5627. TempHeight, TempWidth: Integer;
  5628. pTemp: pByte;
  5629. Row: Integer;
  5630. FormatDesc: TFormatDescriptor;
  5631. begin
  5632. result := false;
  5633. if not init_libJPEG then
  5634. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5635. try
  5636. // reading first two bytes to test file and set cursor back to begin
  5637. StreamPos := aStream.Position;
  5638. aStream.Read({%H-}Temp[0], 2);
  5639. aStream.Position := StreamPos;
  5640. // if Bitmap then read file.
  5641. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5642. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5643. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5644. // error managment
  5645. jpeg.err := jpeg_std_error(@jpeg_err);
  5646. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5647. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5648. // decompression struct
  5649. jpeg_create_decompress(@jpeg);
  5650. // allocation space for streaming methods
  5651. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5652. // seeting up custom functions
  5653. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5654. pub.init_source := glBitmap_libJPEG_init_source;
  5655. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5656. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5657. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5658. pub.term_source := glBitmap_libJPEG_term_source;
  5659. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5660. pub.next_input_byte := nil; // until buffer loaded
  5661. SrcStream := aStream;
  5662. end;
  5663. // set global decoding state
  5664. jpeg.global_state := DSTATE_START;
  5665. // read header of jpeg
  5666. jpeg_read_header(@jpeg, false);
  5667. // setting output parameter
  5668. case jpeg.jpeg_color_space of
  5669. JCS_GRAYSCALE:
  5670. begin
  5671. jpeg.out_color_space := JCS_GRAYSCALE;
  5672. IntFormat := tfLuminance8;
  5673. end;
  5674. else
  5675. jpeg.out_color_space := JCS_RGB;
  5676. IntFormat := tfRGB8;
  5677. end;
  5678. // reading image
  5679. jpeg_start_decompress(@jpeg);
  5680. TempHeight := jpeg.output_height;
  5681. TempWidth := jpeg.output_width;
  5682. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5683. // creating new image
  5684. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5685. try
  5686. pTemp := pImage;
  5687. for Row := 0 to TempHeight -1 do begin
  5688. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5689. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5690. end;
  5691. // finish decompression
  5692. jpeg_finish_decompress(@jpeg);
  5693. // destroy decompression
  5694. jpeg_destroy_decompress(@jpeg);
  5695. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5696. result := true;
  5697. except
  5698. if Assigned(pImage) then
  5699. FreeMem(pImage);
  5700. raise;
  5701. end;
  5702. end;
  5703. finally
  5704. quit_libJPEG;
  5705. end;
  5706. end;
  5707. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5708. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5709. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5710. var
  5711. bmp: TBitmap;
  5712. jpg: TJPEGImage;
  5713. StreamPos: Int64;
  5714. Temp: array[0..1]of Byte;
  5715. begin
  5716. result := false;
  5717. // reading first two bytes to test file and set cursor back to begin
  5718. StreamPos := aStream.Position;
  5719. aStream.Read(Temp[0], 2);
  5720. aStream.Position := StreamPos;
  5721. // if Bitmap then read file.
  5722. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5723. bmp := TBitmap.Create;
  5724. try
  5725. jpg := TJPEGImage.Create;
  5726. try
  5727. jpg.LoadFromStream(aStream);
  5728. bmp.Assign(jpg);
  5729. result := AssignFromBitmap(bmp);
  5730. finally
  5731. jpg.Free;
  5732. end;
  5733. finally
  5734. bmp.Free;
  5735. end;
  5736. end;
  5737. end;
  5738. {$IFEND}
  5739. {$ENDIF}
  5740. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5741. {$IF DEFINED(GLB_LAZ_JPEG)}
  5742. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5743. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5744. var
  5745. jpeg: TJPEGImage;
  5746. intf: TLazIntfImage;
  5747. raw: TRawImage;
  5748. begin
  5749. jpeg := TJPEGImage.Create;
  5750. intf := TLazIntfImage.Create(0, 0);
  5751. try
  5752. if not AssignToLazIntfImage(intf) then
  5753. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5754. intf.GetRawImage(raw);
  5755. jpeg.LoadFromRawImage(raw, false);
  5756. jpeg.SaveToStream(aStream);
  5757. finally
  5758. intf.Free;
  5759. jpeg.Free;
  5760. end;
  5761. end;
  5762. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5763. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5764. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5765. var
  5766. jpeg: jpeg_compress_struct;
  5767. jpeg_err: jpeg_error_mgr;
  5768. Row: Integer;
  5769. pTemp, pTemp2: pByte;
  5770. procedure CopyRow(pDest, pSource: pByte);
  5771. var
  5772. X: Integer;
  5773. begin
  5774. for X := 0 to Width - 1 do begin
  5775. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5776. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5777. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5778. Inc(pDest, 3);
  5779. Inc(pSource, 3);
  5780. end;
  5781. end;
  5782. begin
  5783. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5784. raise EglBitmapUnsupportedFormat.Create(Format);
  5785. if not init_libJPEG then
  5786. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5787. try
  5788. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  5789. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5790. // error managment
  5791. jpeg.err := jpeg_std_error(@jpeg_err);
  5792. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5793. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5794. // compression struct
  5795. jpeg_create_compress(@jpeg);
  5796. // allocation space for streaming methods
  5797. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5798. // seeting up custom functions
  5799. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5800. pub.init_destination := glBitmap_libJPEG_init_destination;
  5801. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5802. pub.term_destination := glBitmap_libJPEG_term_destination;
  5803. pub.next_output_byte := @DestBuffer[1];
  5804. pub.free_in_buffer := Length(DestBuffer);
  5805. DestStream := aStream;
  5806. end;
  5807. // very important state
  5808. jpeg.global_state := CSTATE_START;
  5809. jpeg.image_width := Width;
  5810. jpeg.image_height := Height;
  5811. case Format of
  5812. tfAlpha8, tfLuminance8: begin
  5813. jpeg.input_components := 1;
  5814. jpeg.in_color_space := JCS_GRAYSCALE;
  5815. end;
  5816. tfRGB8, tfBGR8: begin
  5817. jpeg.input_components := 3;
  5818. jpeg.in_color_space := JCS_RGB;
  5819. end;
  5820. end;
  5821. jpeg_set_defaults(@jpeg);
  5822. jpeg_set_quality(@jpeg, 95, true);
  5823. jpeg_start_compress(@jpeg, true);
  5824. pTemp := Data;
  5825. if Format = tfBGR8 then
  5826. GetMem(pTemp2, fRowSize)
  5827. else
  5828. pTemp2 := pTemp;
  5829. try
  5830. for Row := 0 to jpeg.image_height -1 do begin
  5831. // prepare row
  5832. if Format = tfBGR8 then
  5833. CopyRow(pTemp2, pTemp)
  5834. else
  5835. pTemp2 := pTemp;
  5836. // write row
  5837. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5838. inc(pTemp, fRowSize);
  5839. end;
  5840. finally
  5841. // free memory
  5842. if Format = tfBGR8 then
  5843. FreeMem(pTemp2);
  5844. end;
  5845. jpeg_finish_compress(@jpeg);
  5846. jpeg_destroy_compress(@jpeg);
  5847. finally
  5848. quit_libJPEG;
  5849. end;
  5850. end;
  5851. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5852. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5853. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5854. var
  5855. Bmp: TBitmap;
  5856. Jpg: TJPEGImage;
  5857. begin
  5858. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5859. raise EglBitmapUnsupportedFormat.Create(Format);
  5860. Bmp := TBitmap.Create;
  5861. try
  5862. Jpg := TJPEGImage.Create;
  5863. try
  5864. AssignToBitmap(Bmp);
  5865. if (Format in [tfAlpha8, tfLuminance8]) then begin
  5866. Jpg.Grayscale := true;
  5867. Jpg.PixelFormat := jf8Bit;
  5868. end;
  5869. Jpg.Assign(Bmp);
  5870. Jpg.SaveToStream(aStream);
  5871. finally
  5872. FreeAndNil(Jpg);
  5873. end;
  5874. finally
  5875. FreeAndNil(Bmp);
  5876. end;
  5877. end;
  5878. {$IFEND}
  5879. {$ENDIF}
  5880. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5881. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5882. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5883. const
  5884. BMP_MAGIC = $4D42;
  5885. BMP_COMP_RGB = 0;
  5886. BMP_COMP_RLE8 = 1;
  5887. BMP_COMP_RLE4 = 2;
  5888. BMP_COMP_BITFIELDS = 3;
  5889. type
  5890. TBMPHeader = packed record
  5891. bfType: Word;
  5892. bfSize: Cardinal;
  5893. bfReserved1: Word;
  5894. bfReserved2: Word;
  5895. bfOffBits: Cardinal;
  5896. end;
  5897. TBMPInfo = packed record
  5898. biSize: Cardinal;
  5899. biWidth: Longint;
  5900. biHeight: Longint;
  5901. biPlanes: Word;
  5902. biBitCount: Word;
  5903. biCompression: Cardinal;
  5904. biSizeImage: Cardinal;
  5905. biXPelsPerMeter: Longint;
  5906. biYPelsPerMeter: Longint;
  5907. biClrUsed: Cardinal;
  5908. biClrImportant: Cardinal;
  5909. end;
  5910. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5911. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5912. //////////////////////////////////////////////////////////////////////////////////////////////////
  5913. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5914. begin
  5915. result := tfEmpty;
  5916. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5917. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5918. //Read Compression
  5919. case aInfo.biCompression of
  5920. BMP_COMP_RLE4,
  5921. BMP_COMP_RLE8: begin
  5922. raise EglBitmap.Create('RLE compression is not supported');
  5923. end;
  5924. BMP_COMP_BITFIELDS: begin
  5925. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5926. aStream.Read(aMask.r, SizeOf(aMask.r));
  5927. aStream.Read(aMask.g, SizeOf(aMask.g));
  5928. aStream.Read(aMask.b, SizeOf(aMask.b));
  5929. aStream.Read(aMask.a, SizeOf(aMask.a));
  5930. end else
  5931. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  5932. end;
  5933. end;
  5934. //get suitable format
  5935. case aInfo.biBitCount of
  5936. 8: result := tfLuminance8;
  5937. 16: result := tfBGR5;
  5938. 24: result := tfBGR8;
  5939. 32: result := tfBGRA8;
  5940. end;
  5941. end;
  5942. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5943. var
  5944. i, c: Integer;
  5945. ColorTable: TbmpColorTable;
  5946. begin
  5947. result := nil;
  5948. if (aInfo.biBitCount >= 16) then
  5949. exit;
  5950. aFormat := tfLuminance8;
  5951. c := aInfo.biClrUsed;
  5952. if (c = 0) then
  5953. c := 1 shl aInfo.biBitCount;
  5954. SetLength(ColorTable, c);
  5955. for i := 0 to c-1 do begin
  5956. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5957. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5958. aFormat := tfRGB8;
  5959. end;
  5960. result := TbmpColorTableFormat.Create;
  5961. result.PixelSize := aInfo.biBitCount / 8;
  5962. result.ColorTable := ColorTable;
  5963. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5964. end;
  5965. //////////////////////////////////////////////////////////////////////////////////////////////////
  5966. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5967. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5968. var
  5969. TmpFormat: TglBitmapFormat;
  5970. FormatDesc: TFormatDescriptor;
  5971. begin
  5972. result := nil;
  5973. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5974. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5975. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5976. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5977. aFormat := FormatDesc.Format;
  5978. exit;
  5979. end;
  5980. end;
  5981. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5982. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5983. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5984. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5985. result := TbmpBitfieldFormat.Create;
  5986. result.PixelSize := aInfo.biBitCount / 8;
  5987. result.RedMask := aMask.r;
  5988. result.GreenMask := aMask.g;
  5989. result.BlueMask := aMask.b;
  5990. result.AlphaMask := aMask.a;
  5991. end;
  5992. end;
  5993. var
  5994. //simple types
  5995. StartPos: Int64;
  5996. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5997. PaddingBuff: Cardinal;
  5998. LineBuf, ImageData, TmpData: PByte;
  5999. SourceMD, DestMD: Pointer;
  6000. BmpFormat: TglBitmapFormat;
  6001. //records
  6002. Mask: TglBitmapColorRec;
  6003. Header: TBMPHeader;
  6004. Info: TBMPInfo;
  6005. //classes
  6006. SpecialFormat: TFormatDescriptor;
  6007. FormatDesc: TFormatDescriptor;
  6008. //////////////////////////////////////////////////////////////////////////////////////////////////
  6009. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  6010. var
  6011. i: Integer;
  6012. Pixel: TglBitmapPixelData;
  6013. begin
  6014. aStream.Read(aLineBuf^, rbLineSize);
  6015. SpecialFormat.PreparePixel(Pixel);
  6016. for i := 0 to Info.biWidth-1 do begin
  6017. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  6018. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  6019. FormatDesc.Map(Pixel, aData, DestMD);
  6020. end;
  6021. end;
  6022. begin
  6023. result := false;
  6024. BmpFormat := tfEmpty;
  6025. SpecialFormat := nil;
  6026. LineBuf := nil;
  6027. SourceMD := nil;
  6028. DestMD := nil;
  6029. // Header
  6030. StartPos := aStream.Position;
  6031. aStream.Read(Header{%H-}, SizeOf(Header));
  6032. if Header.bfType = BMP_MAGIC then begin
  6033. try try
  6034. BmpFormat := ReadInfo(Info, Mask);
  6035. SpecialFormat := ReadColorTable(BmpFormat, Info);
  6036. if not Assigned(SpecialFormat) then
  6037. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  6038. aStream.Position := StartPos + Header.bfOffBits;
  6039. if (BmpFormat <> tfEmpty) then begin
  6040. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  6041. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  6042. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  6043. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  6044. //get Memory
  6045. DestMD := FormatDesc.CreateMappingData;
  6046. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  6047. GetMem(ImageData, ImageSize);
  6048. if Assigned(SpecialFormat) then begin
  6049. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  6050. SourceMD := SpecialFormat.CreateMappingData;
  6051. end;
  6052. //read Data
  6053. try try
  6054. FillChar(ImageData^, ImageSize, $FF);
  6055. TmpData := ImageData;
  6056. if (Info.biHeight > 0) then
  6057. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  6058. for i := 0 to Abs(Info.biHeight)-1 do begin
  6059. if Assigned(SpecialFormat) then
  6060. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  6061. else
  6062. aStream.Read(TmpData^, wbLineSize); //else only read data
  6063. if (Info.biHeight > 0) then
  6064. dec(TmpData, wbLineSize)
  6065. else
  6066. inc(TmpData, wbLineSize);
  6067. aStream.Read(PaddingBuff{%H-}, Padding);
  6068. end;
  6069. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6070. result := true;
  6071. finally
  6072. if Assigned(LineBuf) then
  6073. FreeMem(LineBuf);
  6074. if Assigned(SourceMD) then
  6075. SpecialFormat.FreeMappingData(SourceMD);
  6076. FormatDesc.FreeMappingData(DestMD);
  6077. end;
  6078. except
  6079. if Assigned(ImageData) then
  6080. FreeMem(ImageData);
  6081. raise;
  6082. end;
  6083. end else
  6084. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6085. except
  6086. aStream.Position := StartPos;
  6087. raise;
  6088. end;
  6089. finally
  6090. FreeAndNil(SpecialFormat);
  6091. end;
  6092. end
  6093. else aStream.Position := StartPos;
  6094. end;
  6095. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6096. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6097. var
  6098. Header: TBMPHeader;
  6099. Info: TBMPInfo;
  6100. Converter: TFormatDescriptor;
  6101. FormatDesc: TFormatDescriptor;
  6102. SourceFD, DestFD: Pointer;
  6103. pData, srcData, dstData, ConvertBuffer: pByte;
  6104. Pixel: TglBitmapPixelData;
  6105. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6106. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6107. PaddingBuff: Cardinal;
  6108. function GetLineWidth : Integer;
  6109. begin
  6110. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6111. end;
  6112. begin
  6113. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6114. raise EglBitmapUnsupportedFormat.Create(Format);
  6115. Converter := nil;
  6116. FormatDesc := TFormatDescriptor.Get(Format);
  6117. ImageSize := FormatDesc.GetSize(Dimension);
  6118. FillChar(Header{%H-}, SizeOf(Header), 0);
  6119. Header.bfType := BMP_MAGIC;
  6120. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6121. Header.bfReserved1 := 0;
  6122. Header.bfReserved2 := 0;
  6123. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6124. FillChar(Info{%H-}, SizeOf(Info), 0);
  6125. Info.biSize := SizeOf(Info);
  6126. Info.biWidth := Width;
  6127. Info.biHeight := Height;
  6128. Info.biPlanes := 1;
  6129. Info.biCompression := BMP_COMP_RGB;
  6130. Info.biSizeImage := ImageSize;
  6131. try
  6132. case Format of
  6133. tfLuminance4: begin
  6134. Info.biBitCount := 4;
  6135. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  6136. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  6137. Converter := TbmpColorTableFormat.Create;
  6138. with (Converter as TbmpColorTableFormat) do begin
  6139. PixelSize := 0.5;
  6140. Format := Format;
  6141. Range := glBitmapColorRec($F, $F, $F, $0);
  6142. CreateColorTable;
  6143. end;
  6144. end;
  6145. tfR3G3B2, tfLuminance8: begin
  6146. Info.biBitCount := 8;
  6147. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6148. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6149. Converter := TbmpColorTableFormat.Create;
  6150. with (Converter as TbmpColorTableFormat) do begin
  6151. PixelSize := 1;
  6152. Format := Format;
  6153. if (Format = tfR3G3B2) then begin
  6154. Range := glBitmapColorRec($7, $7, $3, $0);
  6155. Shift := glBitmapShiftRec(0, 3, 6, 0);
  6156. end else
  6157. Range := glBitmapColorRec($FF, $FF, $FF, $0);
  6158. CreateColorTable;
  6159. end;
  6160. end;
  6161. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  6162. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  6163. Info.biBitCount := 16;
  6164. Info.biCompression := BMP_COMP_BITFIELDS;
  6165. end;
  6166. tfBGR8, tfRGB8: begin
  6167. Info.biBitCount := 24;
  6168. if (Format = tfRGB8) then
  6169. Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6170. end;
  6171. tfRGB10, tfRGB10A2, tfRGBA8,
  6172. tfBGR10, tfBGR10A2, tfBGRA8: begin
  6173. Info.biBitCount := 32;
  6174. Info.biCompression := BMP_COMP_BITFIELDS;
  6175. end;
  6176. else
  6177. raise EglBitmapUnsupportedFormat.Create(Format);
  6178. end;
  6179. Info.biXPelsPerMeter := 2835;
  6180. Info.biYPelsPerMeter := 2835;
  6181. // prepare bitmasks
  6182. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6183. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6184. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6185. RedMask := FormatDesc.RedMask;
  6186. GreenMask := FormatDesc.GreenMask;
  6187. BlueMask := FormatDesc.BlueMask;
  6188. AlphaMask := FormatDesc.AlphaMask;
  6189. end;
  6190. // headers
  6191. aStream.Write(Header, SizeOf(Header));
  6192. aStream.Write(Info, SizeOf(Info));
  6193. // colortable
  6194. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6195. with (Converter as TbmpColorTableFormat) do
  6196. aStream.Write(ColorTable[0].b,
  6197. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6198. // bitmasks
  6199. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6200. aStream.Write(RedMask, SizeOf(Cardinal));
  6201. aStream.Write(GreenMask, SizeOf(Cardinal));
  6202. aStream.Write(BlueMask, SizeOf(Cardinal));
  6203. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6204. end;
  6205. // image data
  6206. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  6207. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6208. Padding := GetLineWidth - wbLineSize;
  6209. PaddingBuff := 0;
  6210. pData := Data;
  6211. inc(pData, (Height-1) * rbLineSize);
  6212. // prepare row buffer. But only for RGB because RGBA supports color masks
  6213. // so it's possible to change color within the image.
  6214. if Assigned(Converter) then begin
  6215. FormatDesc.PreparePixel(Pixel);
  6216. GetMem(ConvertBuffer, wbLineSize);
  6217. SourceFD := FormatDesc.CreateMappingData;
  6218. DestFD := Converter.CreateMappingData;
  6219. end else
  6220. ConvertBuffer := nil;
  6221. try
  6222. for LineIdx := 0 to Height - 1 do begin
  6223. // preparing row
  6224. if Assigned(Converter) then begin
  6225. srcData := pData;
  6226. dstData := ConvertBuffer;
  6227. for PixelIdx := 0 to Info.biWidth-1 do begin
  6228. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6229. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6230. Converter.Map(Pixel, dstData, DestFD);
  6231. end;
  6232. aStream.Write(ConvertBuffer^, wbLineSize);
  6233. end else begin
  6234. aStream.Write(pData^, rbLineSize);
  6235. end;
  6236. dec(pData, rbLineSize);
  6237. if (Padding > 0) then
  6238. aStream.Write(PaddingBuff, Padding);
  6239. end;
  6240. finally
  6241. // destroy row buffer
  6242. if Assigned(ConvertBuffer) then begin
  6243. FormatDesc.FreeMappingData(SourceFD);
  6244. Converter.FreeMappingData(DestFD);
  6245. FreeMem(ConvertBuffer);
  6246. end;
  6247. end;
  6248. finally
  6249. if Assigned(Converter) then
  6250. Converter.Free;
  6251. end;
  6252. end;
  6253. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6254. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6255. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6256. type
  6257. TTGAHeader = packed record
  6258. ImageID: Byte;
  6259. ColorMapType: Byte;
  6260. ImageType: Byte;
  6261. //ColorMapSpec: Array[0..4] of Byte;
  6262. ColorMapStart: Word;
  6263. ColorMapLength: Word;
  6264. ColorMapEntrySize: Byte;
  6265. OrigX: Word;
  6266. OrigY: Word;
  6267. Width: Word;
  6268. Height: Word;
  6269. Bpp: Byte;
  6270. ImageDesc: Byte;
  6271. end;
  6272. const
  6273. TGA_UNCOMPRESSED_RGB = 2;
  6274. TGA_UNCOMPRESSED_GRAY = 3;
  6275. TGA_COMPRESSED_RGB = 10;
  6276. TGA_COMPRESSED_GRAY = 11;
  6277. TGA_NONE_COLOR_TABLE = 0;
  6278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6279. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6280. var
  6281. Header: TTGAHeader;
  6282. ImageData: System.PByte;
  6283. StartPosition: Int64;
  6284. PixelSize, LineSize: Integer;
  6285. tgaFormat: TglBitmapFormat;
  6286. FormatDesc: TFormatDescriptor;
  6287. Counter: packed record
  6288. X, Y: packed record
  6289. low, high, dir: Integer;
  6290. end;
  6291. end;
  6292. const
  6293. CACHE_SIZE = $4000;
  6294. ////////////////////////////////////////////////////////////////////////////////////////
  6295. procedure ReadUncompressed;
  6296. var
  6297. i, j: Integer;
  6298. buf, tmp1, tmp2: System.PByte;
  6299. begin
  6300. buf := nil;
  6301. if (Counter.X.dir < 0) then
  6302. GetMem(buf, LineSize);
  6303. try
  6304. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6305. tmp1 := ImageData;
  6306. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6307. if (Counter.X.dir < 0) then begin //flip X
  6308. aStream.Read(buf^, LineSize);
  6309. tmp2 := buf;
  6310. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6311. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6312. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6313. tmp1^ := tmp2^;
  6314. inc(tmp1);
  6315. inc(tmp2);
  6316. end;
  6317. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6318. end;
  6319. end else
  6320. aStream.Read(tmp1^, LineSize);
  6321. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6322. end;
  6323. finally
  6324. if Assigned(buf) then
  6325. FreeMem(buf);
  6326. end;
  6327. end;
  6328. ////////////////////////////////////////////////////////////////////////////////////////
  6329. procedure ReadCompressed;
  6330. /////////////////////////////////////////////////////////////////
  6331. var
  6332. TmpData: System.PByte;
  6333. LinePixelsRead: Integer;
  6334. procedure CheckLine;
  6335. begin
  6336. if (LinePixelsRead >= Header.Width) then begin
  6337. LinePixelsRead := 0;
  6338. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6339. TmpData := ImageData;
  6340. inc(TmpData, Counter.Y.low * LineSize); //set line
  6341. if (Counter.X.dir < 0) then //if x flipped then
  6342. inc(TmpData, LineSize - PixelSize); //set last pixel
  6343. end;
  6344. end;
  6345. /////////////////////////////////////////////////////////////////
  6346. var
  6347. Cache: PByte;
  6348. CacheSize, CachePos: Integer;
  6349. procedure CachedRead(out Buffer; Count: Integer);
  6350. var
  6351. BytesRead: Integer;
  6352. begin
  6353. if (CachePos + Count > CacheSize) then begin
  6354. //if buffer overflow save non read bytes
  6355. BytesRead := 0;
  6356. if (CacheSize - CachePos > 0) then begin
  6357. BytesRead := CacheSize - CachePos;
  6358. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6359. inc(CachePos, BytesRead);
  6360. end;
  6361. //load cache from file
  6362. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6363. aStream.Read(Cache^, CacheSize);
  6364. CachePos := 0;
  6365. //read rest of requested bytes
  6366. if (Count - BytesRead > 0) then begin
  6367. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6368. inc(CachePos, Count - BytesRead);
  6369. end;
  6370. end else begin
  6371. //if no buffer overflow just read the data
  6372. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6373. inc(CachePos, Count);
  6374. end;
  6375. end;
  6376. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6377. begin
  6378. case PixelSize of
  6379. 1: begin
  6380. aBuffer^ := aData^;
  6381. inc(aBuffer, Counter.X.dir);
  6382. end;
  6383. 2: begin
  6384. PWord(aBuffer)^ := PWord(aData)^;
  6385. inc(aBuffer, 2 * Counter.X.dir);
  6386. end;
  6387. 3: begin
  6388. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6389. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6390. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6391. inc(aBuffer, 3 * Counter.X.dir);
  6392. end;
  6393. 4: begin
  6394. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6395. inc(aBuffer, 4 * Counter.X.dir);
  6396. end;
  6397. end;
  6398. end;
  6399. var
  6400. TotalPixelsToRead, TotalPixelsRead: Integer;
  6401. Temp: Byte;
  6402. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6403. PixelRepeat: Boolean;
  6404. PixelsToRead, PixelCount: Integer;
  6405. begin
  6406. CacheSize := 0;
  6407. CachePos := 0;
  6408. TotalPixelsToRead := Header.Width * Header.Height;
  6409. TotalPixelsRead := 0;
  6410. LinePixelsRead := 0;
  6411. GetMem(Cache, CACHE_SIZE);
  6412. try
  6413. TmpData := ImageData;
  6414. inc(TmpData, Counter.Y.low * LineSize); //set line
  6415. if (Counter.X.dir < 0) then //if x flipped then
  6416. inc(TmpData, LineSize - PixelSize); //set last pixel
  6417. repeat
  6418. //read CommandByte
  6419. CachedRead(Temp, 1);
  6420. PixelRepeat := (Temp and $80) > 0;
  6421. PixelsToRead := (Temp and $7F) + 1;
  6422. inc(TotalPixelsRead, PixelsToRead);
  6423. if PixelRepeat then
  6424. CachedRead(buf[0], PixelSize);
  6425. while (PixelsToRead > 0) do begin
  6426. CheckLine;
  6427. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6428. while (PixelCount > 0) do begin
  6429. if not PixelRepeat then
  6430. CachedRead(buf[0], PixelSize);
  6431. PixelToBuffer(@buf[0], TmpData);
  6432. inc(LinePixelsRead);
  6433. dec(PixelsToRead);
  6434. dec(PixelCount);
  6435. end;
  6436. end;
  6437. until (TotalPixelsRead >= TotalPixelsToRead);
  6438. finally
  6439. FreeMem(Cache);
  6440. end;
  6441. end;
  6442. function IsGrayFormat: Boolean;
  6443. begin
  6444. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6445. end;
  6446. begin
  6447. result := false;
  6448. // reading header to test file and set cursor back to begin
  6449. StartPosition := aStream.Position;
  6450. aStream.Read(Header{%H-}, SizeOf(Header));
  6451. // no colormapped files
  6452. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6453. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6454. begin
  6455. try
  6456. if Header.ImageID <> 0 then // skip image ID
  6457. aStream.Position := aStream.Position + Header.ImageID;
  6458. tgaFormat := tfEmpty;
  6459. case Header.Bpp of
  6460. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6461. 0: tgaFormat := tfLuminance8;
  6462. 8: tgaFormat := tfAlpha8;
  6463. end;
  6464. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6465. 0: tgaFormat := tfLuminance16;
  6466. 8: tgaFormat := tfLuminance8Alpha8;
  6467. end else case (Header.ImageDesc and $F) of
  6468. 0: tgaFormat := tfBGR5;
  6469. 1: tgaFormat := tfBGR5A1;
  6470. 4: tgaFormat := tfBGRA4;
  6471. end;
  6472. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6473. 0: tgaFormat := tfBGR8;
  6474. end;
  6475. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6476. 2: tgaFormat := tfBGR10A2;
  6477. 8: tgaFormat := tfBGRA8;
  6478. end;
  6479. end;
  6480. if (tgaFormat = tfEmpty) then
  6481. raise EglBitmap.Create('LoadTga - unsupported format');
  6482. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6483. PixelSize := FormatDesc.GetSize(1, 1);
  6484. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6485. GetMem(ImageData, LineSize * Header.Height);
  6486. try
  6487. //column direction
  6488. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6489. Counter.X.low := Header.Height-1;;
  6490. Counter.X.high := 0;
  6491. Counter.X.dir := -1;
  6492. end else begin
  6493. Counter.X.low := 0;
  6494. Counter.X.high := Header.Height-1;
  6495. Counter.X.dir := 1;
  6496. end;
  6497. // Row direction
  6498. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6499. Counter.Y.low := 0;
  6500. Counter.Y.high := Header.Height-1;
  6501. Counter.Y.dir := 1;
  6502. end else begin
  6503. Counter.Y.low := Header.Height-1;;
  6504. Counter.Y.high := 0;
  6505. Counter.Y.dir := -1;
  6506. end;
  6507. // Read Image
  6508. case Header.ImageType of
  6509. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6510. ReadUncompressed;
  6511. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6512. ReadCompressed;
  6513. end;
  6514. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6515. result := true;
  6516. except
  6517. if Assigned(ImageData) then
  6518. FreeMem(ImageData);
  6519. raise;
  6520. end;
  6521. finally
  6522. aStream.Position := StartPosition;
  6523. end;
  6524. end
  6525. else aStream.Position := StartPosition;
  6526. end;
  6527. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6528. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6529. var
  6530. Header: TTGAHeader;
  6531. LineSize, Size, x, y: Integer;
  6532. Pixel: TglBitmapPixelData;
  6533. LineBuf, SourceData, DestData: PByte;
  6534. SourceMD, DestMD: Pointer;
  6535. FormatDesc: TFormatDescriptor;
  6536. Converter: TFormatDescriptor;
  6537. begin
  6538. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6539. raise EglBitmapUnsupportedFormat.Create(Format);
  6540. //prepare header
  6541. FillChar(Header{%H-}, SizeOf(Header), 0);
  6542. //set ImageType
  6543. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6544. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6545. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6546. else
  6547. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6548. //set BitsPerPixel
  6549. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6550. Header.Bpp := 8
  6551. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6552. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6553. Header.Bpp := 16
  6554. else if (Format in [tfBGR8, tfRGB8]) then
  6555. Header.Bpp := 24
  6556. else
  6557. Header.Bpp := 32;
  6558. //set AlphaBitCount
  6559. case Format of
  6560. tfRGB5A1, tfBGR5A1:
  6561. Header.ImageDesc := 1 and $F;
  6562. tfRGB10A2, tfBGR10A2:
  6563. Header.ImageDesc := 2 and $F;
  6564. tfRGBA4, tfBGRA4:
  6565. Header.ImageDesc := 4 and $F;
  6566. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6567. Header.ImageDesc := 8 and $F;
  6568. end;
  6569. Header.Width := Width;
  6570. Header.Height := Height;
  6571. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6572. aStream.Write(Header, SizeOf(Header));
  6573. // convert RGB(A) to BGR(A)
  6574. Converter := nil;
  6575. FormatDesc := TFormatDescriptor.Get(Format);
  6576. Size := FormatDesc.GetSize(Dimension);
  6577. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6578. if (FormatDesc.RGBInverted = tfEmpty) then
  6579. raise EglBitmap.Create('inverted RGB format is empty');
  6580. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6581. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6582. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6583. raise EglBitmap.Create('invalid inverted RGB format');
  6584. end;
  6585. if Assigned(Converter) then begin
  6586. LineSize := FormatDesc.GetSize(Width, 1);
  6587. GetMem(LineBuf, LineSize);
  6588. SourceMD := FormatDesc.CreateMappingData;
  6589. DestMD := Converter.CreateMappingData;
  6590. try
  6591. SourceData := Data;
  6592. for y := 0 to Height-1 do begin
  6593. DestData := LineBuf;
  6594. for x := 0 to Width-1 do begin
  6595. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6596. Converter.Map(Pixel, DestData, DestMD);
  6597. end;
  6598. aStream.Write(LineBuf^, LineSize);
  6599. end;
  6600. finally
  6601. FreeMem(LineBuf);
  6602. FormatDesc.FreeMappingData(SourceMD);
  6603. FormatDesc.FreeMappingData(DestMD);
  6604. end;
  6605. end else
  6606. aStream.Write(Data^, Size);
  6607. end;
  6608. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6609. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6610. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6611. const
  6612. DDS_MAGIC: Cardinal = $20534444;
  6613. // DDS_header.dwFlags
  6614. DDSD_CAPS = $00000001;
  6615. DDSD_HEIGHT = $00000002;
  6616. DDSD_WIDTH = $00000004;
  6617. DDSD_PIXELFORMAT = $00001000;
  6618. // DDS_header.sPixelFormat.dwFlags
  6619. DDPF_ALPHAPIXELS = $00000001;
  6620. DDPF_ALPHA = $00000002;
  6621. DDPF_FOURCC = $00000004;
  6622. DDPF_RGB = $00000040;
  6623. DDPF_LUMINANCE = $00020000;
  6624. // DDS_header.sCaps.dwCaps1
  6625. DDSCAPS_TEXTURE = $00001000;
  6626. // DDS_header.sCaps.dwCaps2
  6627. DDSCAPS2_CUBEMAP = $00000200;
  6628. D3DFMT_DXT1 = $31545844;
  6629. D3DFMT_DXT3 = $33545844;
  6630. D3DFMT_DXT5 = $35545844;
  6631. type
  6632. TDDSPixelFormat = packed record
  6633. dwSize: Cardinal;
  6634. dwFlags: Cardinal;
  6635. dwFourCC: Cardinal;
  6636. dwRGBBitCount: Cardinal;
  6637. dwRBitMask: Cardinal;
  6638. dwGBitMask: Cardinal;
  6639. dwBBitMask: Cardinal;
  6640. dwABitMask: Cardinal;
  6641. end;
  6642. TDDSCaps = packed record
  6643. dwCaps1: Cardinal;
  6644. dwCaps2: Cardinal;
  6645. dwDDSX: Cardinal;
  6646. dwReserved: Cardinal;
  6647. end;
  6648. TDDSHeader = packed record
  6649. dwSize: Cardinal;
  6650. dwFlags: Cardinal;
  6651. dwHeight: Cardinal;
  6652. dwWidth: Cardinal;
  6653. dwPitchOrLinearSize: Cardinal;
  6654. dwDepth: Cardinal;
  6655. dwMipMapCount: Cardinal;
  6656. dwReserved: array[0..10] of Cardinal;
  6657. PixelFormat: TDDSPixelFormat;
  6658. Caps: TDDSCaps;
  6659. dwReserved2: Cardinal;
  6660. end;
  6661. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6662. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6663. var
  6664. Header: TDDSHeader;
  6665. Converter: TbmpBitfieldFormat;
  6666. function GetDDSFormat: TglBitmapFormat;
  6667. var
  6668. fd: TFormatDescriptor;
  6669. i: Integer;
  6670. Range: TglBitmapColorRec;
  6671. match: Boolean;
  6672. begin
  6673. result := tfEmpty;
  6674. with Header.PixelFormat do begin
  6675. // Compresses
  6676. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6677. case Header.PixelFormat.dwFourCC of
  6678. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6679. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6680. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6681. end;
  6682. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6683. //find matching format
  6684. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6685. fd := TFormatDescriptor.Get(result);
  6686. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6687. (8 * fd.PixelSize = dwRGBBitCount) then
  6688. exit;
  6689. end;
  6690. //find format with same Range
  6691. Range.r := dwRBitMask;
  6692. Range.g := dwGBitMask;
  6693. Range.b := dwBBitMask;
  6694. Range.a := dwABitMask;
  6695. for i := 0 to 3 do begin
  6696. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6697. Range.arr[i] := Range.arr[i] shr 1;
  6698. end;
  6699. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6700. fd := TFormatDescriptor.Get(result);
  6701. match := true;
  6702. for i := 0 to 3 do
  6703. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6704. match := false;
  6705. break;
  6706. end;
  6707. if match then
  6708. break;
  6709. end;
  6710. //no format with same range found -> use default
  6711. if (result = tfEmpty) then begin
  6712. if (dwABitMask > 0) then
  6713. result := tfBGRA8
  6714. else
  6715. result := tfBGR8;
  6716. end;
  6717. Converter := TbmpBitfieldFormat.Create;
  6718. Converter.RedMask := dwRBitMask;
  6719. Converter.GreenMask := dwGBitMask;
  6720. Converter.BlueMask := dwBBitMask;
  6721. Converter.AlphaMask := dwABitMask;
  6722. Converter.PixelSize := dwRGBBitCount / 8;
  6723. end;
  6724. end;
  6725. end;
  6726. var
  6727. StreamPos: Int64;
  6728. x, y, LineSize, RowSize, Magic: Cardinal;
  6729. NewImage, TmpData, RowData, SrcData: System.PByte;
  6730. SourceMD, DestMD: Pointer;
  6731. Pixel: TglBitmapPixelData;
  6732. ddsFormat: TglBitmapFormat;
  6733. FormatDesc: TFormatDescriptor;
  6734. begin
  6735. result := false;
  6736. Converter := nil;
  6737. StreamPos := aStream.Position;
  6738. // Magic
  6739. aStream.Read(Magic{%H-}, sizeof(Magic));
  6740. if (Magic <> DDS_MAGIC) then begin
  6741. aStream.Position := StreamPos;
  6742. exit;
  6743. end;
  6744. //Header
  6745. aStream.Read(Header{%H-}, sizeof(Header));
  6746. if (Header.dwSize <> SizeOf(Header)) or
  6747. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6748. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6749. begin
  6750. aStream.Position := StreamPos;
  6751. exit;
  6752. end;
  6753. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6754. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  6755. ddsFormat := GetDDSFormat;
  6756. try
  6757. if (ddsFormat = tfEmpty) then
  6758. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6759. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6760. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6761. GetMem(NewImage, Header.dwHeight * LineSize);
  6762. try
  6763. TmpData := NewImage;
  6764. //Converter needed
  6765. if Assigned(Converter) then begin
  6766. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6767. GetMem(RowData, RowSize);
  6768. SourceMD := Converter.CreateMappingData;
  6769. DestMD := FormatDesc.CreateMappingData;
  6770. try
  6771. for y := 0 to Header.dwHeight-1 do begin
  6772. TmpData := NewImage;
  6773. inc(TmpData, y * LineSize);
  6774. SrcData := RowData;
  6775. aStream.Read(SrcData^, RowSize);
  6776. for x := 0 to Header.dwWidth-1 do begin
  6777. Converter.Unmap(SrcData, Pixel, SourceMD);
  6778. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6779. FormatDesc.Map(Pixel, TmpData, DestMD);
  6780. end;
  6781. end;
  6782. finally
  6783. Converter.FreeMappingData(SourceMD);
  6784. FormatDesc.FreeMappingData(DestMD);
  6785. FreeMem(RowData);
  6786. end;
  6787. end else
  6788. // Compressed
  6789. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6790. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  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. // Uncompressed
  6797. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6798. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6799. for Y := 0 to Header.dwHeight-1 do begin
  6800. aStream.Read(TmpData^, RowSize);
  6801. Inc(TmpData, LineSize);
  6802. end;
  6803. end else
  6804. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6805. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  6806. result := true;
  6807. except
  6808. if Assigned(NewImage) then
  6809. FreeMem(NewImage);
  6810. raise;
  6811. end;
  6812. finally
  6813. FreeAndNil(Converter);
  6814. end;
  6815. end;
  6816. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6817. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6818. var
  6819. Header: TDDSHeader;
  6820. FormatDesc: TFormatDescriptor;
  6821. begin
  6822. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6823. raise EglBitmapUnsupportedFormat.Create(Format);
  6824. FormatDesc := TFormatDescriptor.Get(Format);
  6825. // Generell
  6826. FillChar(Header{%H-}, SizeOf(Header), 0);
  6827. Header.dwSize := SizeOf(Header);
  6828. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6829. Header.dwWidth := Max(1, Width);
  6830. Header.dwHeight := Max(1, Height);
  6831. // Caps
  6832. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6833. // Pixelformat
  6834. Header.PixelFormat.dwSize := sizeof(Header);
  6835. if (FormatDesc.IsCompressed) then begin
  6836. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6837. case Format of
  6838. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6839. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6840. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6841. end;
  6842. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6843. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6844. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6845. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6846. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6847. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6848. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6849. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6850. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6851. end else begin
  6852. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6853. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6854. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6855. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6856. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6857. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6858. end;
  6859. if (FormatDesc.HasAlpha) then
  6860. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6861. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6862. aStream.Write(Header, SizeOf(Header));
  6863. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6864. end;
  6865. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6866. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6867. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6868. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6869. const aWidth: Integer; const aHeight: Integer);
  6870. var
  6871. pTemp: pByte;
  6872. Size: Integer;
  6873. begin
  6874. if (aHeight > 1) then begin
  6875. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  6876. GetMem(pTemp, Size);
  6877. try
  6878. Move(aData^, pTemp^, Size);
  6879. FreeMem(aData);
  6880. aData := nil;
  6881. except
  6882. FreeMem(pTemp);
  6883. raise;
  6884. end;
  6885. end else
  6886. pTemp := aData;
  6887. inherited SetDataPointer(pTemp, aFormat, aWidth);
  6888. end;
  6889. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6890. function TglBitmap1D.FlipHorz: Boolean;
  6891. var
  6892. Col: Integer;
  6893. pTempDest, pDest, pSource: PByte;
  6894. begin
  6895. result := inherited FlipHorz;
  6896. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  6897. pSource := Data;
  6898. GetMem(pDest, fRowSize);
  6899. try
  6900. pTempDest := pDest;
  6901. Inc(pTempDest, fRowSize);
  6902. for Col := 0 to Width-1 do begin
  6903. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  6904. Move(pSource^, pTempDest^, fPixelSize);
  6905. Inc(pSource, fPixelSize);
  6906. end;
  6907. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  6908. result := true;
  6909. except
  6910. if Assigned(pDest) then
  6911. FreeMem(pDest);
  6912. raise;
  6913. end;
  6914. end;
  6915. end;
  6916. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6917. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  6918. var
  6919. FormatDesc: TFormatDescriptor;
  6920. begin
  6921. // Upload data
  6922. FormatDesc := TFormatDescriptor.Get(Format);
  6923. if FormatDesc.IsCompressed then begin
  6924. if not Assigned(glCompressedTexImage1D) then
  6925. raise EglBitmap.Create('compressed formats not supported by video adapter');
  6926. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  6927. end else if aBuildWithGlu then
  6928. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6929. else
  6930. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6931. // Free Data
  6932. if (FreeDataAfterGenTexture) then
  6933. FreeData;
  6934. end;
  6935. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6936. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  6937. var
  6938. BuildWithGlu, TexRec: Boolean;
  6939. TexSize: Integer;
  6940. begin
  6941. if Assigned(Data) then begin
  6942. // Check Texture Size
  6943. if (aTestTextureSize) then begin
  6944. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6945. if (Width > TexSize) then
  6946. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6947. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6948. (Target = GL_TEXTURE_RECTANGLE);
  6949. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6950. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6951. end;
  6952. CreateId;
  6953. SetupParameters(BuildWithGlu);
  6954. UploadData(BuildWithGlu);
  6955. glAreTexturesResident(1, @fID, @fIsResident);
  6956. end;
  6957. end;
  6958. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6959. procedure TglBitmap1D.AfterConstruction;
  6960. begin
  6961. inherited;
  6962. Target := GL_TEXTURE_1D;
  6963. end;
  6964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6965. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6967. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6968. begin
  6969. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6970. result := fLines[aIndex]
  6971. else
  6972. result := nil;
  6973. end;
  6974. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6975. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6976. const aWidth: Integer; const aHeight: Integer);
  6977. var
  6978. Idx, LineWidth: Integer;
  6979. begin
  6980. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6981. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6982. // Assigning Data
  6983. if Assigned(Data) then begin
  6984. SetLength(fLines, GetHeight);
  6985. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6986. for Idx := 0 to GetHeight-1 do begin
  6987. fLines[Idx] := Data;
  6988. Inc(fLines[Idx], Idx * LineWidth);
  6989. end;
  6990. end
  6991. else SetLength(fLines, 0);
  6992. end else begin
  6993. SetLength(fLines, 0);
  6994. end;
  6995. end;
  6996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6997. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  6998. var
  6999. FormatDesc: TFormatDescriptor;
  7000. begin
  7001. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7002. FormatDesc := TFormatDescriptor.Get(Format);
  7003. if FormatDesc.IsCompressed then begin
  7004. if not Assigned(glCompressedTexImage2D) then
  7005. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7006. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  7007. end else if aBuildWithGlu then begin
  7008. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  7009. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7010. end else begin
  7011. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  7012. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7013. end;
  7014. // Freigeben
  7015. if (FreeDataAfterGenTexture) then
  7016. FreeData;
  7017. end;
  7018. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7019. procedure TglBitmap2D.AfterConstruction;
  7020. begin
  7021. inherited;
  7022. Target := GL_TEXTURE_2D;
  7023. end;
  7024. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7025. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  7026. var
  7027. Temp: pByte;
  7028. Size, w, h: Integer;
  7029. FormatDesc: TFormatDescriptor;
  7030. begin
  7031. FormatDesc := TFormatDescriptor.Get(aFormat);
  7032. if FormatDesc.IsCompressed then
  7033. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7034. w := aRight - aLeft;
  7035. h := aBottom - aTop;
  7036. Size := FormatDesc.GetSize(w, h);
  7037. GetMem(Temp, Size);
  7038. try
  7039. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7040. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7041. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  7042. FlipVert;
  7043. except
  7044. if Assigned(Temp) then
  7045. FreeMem(Temp);
  7046. raise;
  7047. end;
  7048. end;
  7049. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7050. procedure TglBitmap2D.GetDataFromTexture;
  7051. var
  7052. Temp: PByte;
  7053. TempWidth, TempHeight: GLint;
  7054. TempIntFormat: GLenum;
  7055. IntFormat, f: TglBitmapFormat;
  7056. FormatDesc: TFormatDescriptor;
  7057. begin
  7058. Bind;
  7059. // Request Data
  7060. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7061. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7062. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, PGLint(@TempIntFormat));
  7063. IntFormat := tfEmpty;
  7064. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  7065. FormatDesc := TFormatDescriptor.Get(f);
  7066. if (FormatDesc.glInternalFormat = TempIntFormat) then begin
  7067. IntFormat := FormatDesc.Format;
  7068. break;
  7069. end;
  7070. end;
  7071. // Getting data from OpenGL
  7072. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7073. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7074. try
  7075. if FormatDesc.IsCompressed then begin
  7076. if not Assigned(glGetCompressedTexImage) then
  7077. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7078. glGetCompressedTexImage(Target, 0, Temp)
  7079. end else
  7080. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7081. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7082. except
  7083. if Assigned(Temp) then
  7084. FreeMem(Temp);
  7085. raise;
  7086. end;
  7087. end;
  7088. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7089. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7090. var
  7091. BuildWithGlu, PotTex, TexRec: Boolean;
  7092. TexSize: Integer;
  7093. begin
  7094. if Assigned(Data) then begin
  7095. // Check Texture Size
  7096. if (aTestTextureSize) then begin
  7097. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7098. if ((Height > TexSize) or (Width > TexSize)) then
  7099. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7100. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7101. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7102. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7103. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7104. end;
  7105. CreateId;
  7106. SetupParameters(BuildWithGlu);
  7107. UploadData(Target, BuildWithGlu);
  7108. glAreTexturesResident(1, @fID, @fIsResident);
  7109. end;
  7110. end;
  7111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7112. function TglBitmap2D.FlipHorz: Boolean;
  7113. var
  7114. Col, Row: Integer;
  7115. TempDestData, DestData, SourceData: PByte;
  7116. ImgSize: Integer;
  7117. begin
  7118. result := inherited FlipHorz;
  7119. if Assigned(Data) then begin
  7120. SourceData := Data;
  7121. ImgSize := Height * fRowSize;
  7122. GetMem(DestData, ImgSize);
  7123. try
  7124. TempDestData := DestData;
  7125. Dec(TempDestData, fRowSize + fPixelSize);
  7126. for Row := 0 to Height -1 do begin
  7127. Inc(TempDestData, fRowSize * 2);
  7128. for Col := 0 to Width -1 do begin
  7129. Move(SourceData^, TempDestData^, fPixelSize);
  7130. Inc(SourceData, fPixelSize);
  7131. Dec(TempDestData, fPixelSize);
  7132. end;
  7133. end;
  7134. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7135. result := true;
  7136. except
  7137. if Assigned(DestData) then
  7138. FreeMem(DestData);
  7139. raise;
  7140. end;
  7141. end;
  7142. end;
  7143. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7144. function TglBitmap2D.FlipVert: Boolean;
  7145. var
  7146. Row: Integer;
  7147. TempDestData, DestData, SourceData: PByte;
  7148. begin
  7149. result := inherited FlipVert;
  7150. if Assigned(Data) then begin
  7151. SourceData := Data;
  7152. GetMem(DestData, Height * fRowSize);
  7153. try
  7154. TempDestData := DestData;
  7155. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7156. for Row := 0 to Height -1 do begin
  7157. Move(SourceData^, TempDestData^, fRowSize);
  7158. Dec(TempDestData, fRowSize);
  7159. Inc(SourceData, fRowSize);
  7160. end;
  7161. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7162. result := true;
  7163. except
  7164. if Assigned(DestData) then
  7165. FreeMem(DestData);
  7166. raise;
  7167. end;
  7168. end;
  7169. end;
  7170. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7171. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7173. type
  7174. TMatrixItem = record
  7175. X, Y: Integer;
  7176. W: Single;
  7177. end;
  7178. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7179. TglBitmapToNormalMapRec = Record
  7180. Scale: Single;
  7181. Heights: array of Single;
  7182. MatrixU : array of TMatrixItem;
  7183. MatrixV : array of TMatrixItem;
  7184. end;
  7185. const
  7186. ONE_OVER_255 = 1 / 255;
  7187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7188. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7189. var
  7190. Val: Single;
  7191. begin
  7192. with FuncRec do begin
  7193. Val :=
  7194. Source.Data.r * LUMINANCE_WEIGHT_R +
  7195. Source.Data.g * LUMINANCE_WEIGHT_G +
  7196. Source.Data.b * LUMINANCE_WEIGHT_B;
  7197. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7198. end;
  7199. end;
  7200. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7201. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7202. begin
  7203. with FuncRec do
  7204. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7205. end;
  7206. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7207. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7208. type
  7209. TVec = Array[0..2] of Single;
  7210. var
  7211. Idx: Integer;
  7212. du, dv: Double;
  7213. Len: Single;
  7214. Vec: TVec;
  7215. function GetHeight(X, Y: Integer): Single;
  7216. begin
  7217. with FuncRec do begin
  7218. X := Max(0, Min(Size.X -1, X));
  7219. Y := Max(0, Min(Size.Y -1, Y));
  7220. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7221. end;
  7222. end;
  7223. begin
  7224. with FuncRec do begin
  7225. with PglBitmapToNormalMapRec(Args)^ do begin
  7226. du := 0;
  7227. for Idx := Low(MatrixU) to High(MatrixU) do
  7228. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7229. dv := 0;
  7230. for Idx := Low(MatrixU) to High(MatrixU) do
  7231. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7232. Vec[0] := -du * Scale;
  7233. Vec[1] := -dv * Scale;
  7234. Vec[2] := 1;
  7235. end;
  7236. // Normalize
  7237. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7238. if Len <> 0 then begin
  7239. Vec[0] := Vec[0] * Len;
  7240. Vec[1] := Vec[1] * Len;
  7241. Vec[2] := Vec[2] * Len;
  7242. end;
  7243. // Farbe zuweisem
  7244. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7245. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7246. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7247. end;
  7248. end;
  7249. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7250. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7251. var
  7252. Rec: TglBitmapToNormalMapRec;
  7253. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7254. begin
  7255. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7256. Matrix[Index].X := X;
  7257. Matrix[Index].Y := Y;
  7258. Matrix[Index].W := W;
  7259. end;
  7260. end;
  7261. begin
  7262. if TFormatDescriptor.Get(Format).IsCompressed then
  7263. raise EglBitmapUnsupportedFormat.Create(Format);
  7264. if aScale > 100 then
  7265. Rec.Scale := 100
  7266. else if aScale < -100 then
  7267. Rec.Scale := -100
  7268. else
  7269. Rec.Scale := aScale;
  7270. SetLength(Rec.Heights, Width * Height);
  7271. try
  7272. case aFunc of
  7273. nm4Samples: begin
  7274. SetLength(Rec.MatrixU, 2);
  7275. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7276. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7277. SetLength(Rec.MatrixV, 2);
  7278. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7279. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7280. end;
  7281. nmSobel: begin
  7282. SetLength(Rec.MatrixU, 6);
  7283. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7284. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7285. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7286. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7287. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7288. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7289. SetLength(Rec.MatrixV, 6);
  7290. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7291. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7292. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7293. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7294. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7295. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7296. end;
  7297. nm3x3: begin
  7298. SetLength(Rec.MatrixU, 6);
  7299. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7300. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7301. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7302. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7303. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7304. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7305. SetLength(Rec.MatrixV, 6);
  7306. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7307. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7308. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7309. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7310. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7311. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7312. end;
  7313. nm5x5: begin
  7314. SetLength(Rec.MatrixU, 20);
  7315. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7316. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7317. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7318. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7319. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7320. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7321. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7322. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7323. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7324. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7325. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7326. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7327. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7328. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7329. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7330. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7331. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7332. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7333. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7334. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7335. SetLength(Rec.MatrixV, 20);
  7336. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7337. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7338. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7339. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7340. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7341. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7342. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7343. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7344. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7345. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7346. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7347. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7348. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7349. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7350. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7351. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7352. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7353. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7354. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7355. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7356. end;
  7357. end;
  7358. // Daten Sammeln
  7359. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7360. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7361. else
  7362. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7363. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7364. finally
  7365. SetLength(Rec.Heights, 0);
  7366. end;
  7367. end;
  7368. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7369. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7370. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7371. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7372. begin
  7373. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7374. end;
  7375. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7376. procedure TglBitmapCubeMap.AfterConstruction;
  7377. begin
  7378. inherited;
  7379. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7380. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7381. SetWrap;
  7382. Target := GL_TEXTURE_CUBE_MAP;
  7383. fGenMode := GL_REFLECTION_MAP;
  7384. end;
  7385. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7386. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7387. var
  7388. BuildWithGlu: Boolean;
  7389. TexSize: Integer;
  7390. begin
  7391. if (aTestTextureSize) then begin
  7392. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7393. if (Height > TexSize) or (Width > TexSize) then
  7394. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7395. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7396. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7397. end;
  7398. if (ID = 0) then
  7399. CreateID;
  7400. SetupParameters(BuildWithGlu);
  7401. UploadData(aCubeTarget, BuildWithGlu);
  7402. end;
  7403. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7404. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
  7405. begin
  7406. inherited Bind (aEnableTextureUnit);
  7407. if aEnableTexCoordsGen then begin
  7408. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7409. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7410. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7411. glEnable(GL_TEXTURE_GEN_S);
  7412. glEnable(GL_TEXTURE_GEN_T);
  7413. glEnable(GL_TEXTURE_GEN_R);
  7414. end;
  7415. end;
  7416. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7417. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
  7418. begin
  7419. inherited Unbind(aDisableTextureUnit);
  7420. if aDisableTexCoordsGen then begin
  7421. glDisable(GL_TEXTURE_GEN_S);
  7422. glDisable(GL_TEXTURE_GEN_T);
  7423. glDisable(GL_TEXTURE_GEN_R);
  7424. end;
  7425. end;
  7426. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7427. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7428. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7429. type
  7430. TVec = Array[0..2] of Single;
  7431. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7432. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7433. TglBitmapNormalMapRec = record
  7434. HalfSize : Integer;
  7435. Func: TglBitmapNormalMapGetVectorFunc;
  7436. end;
  7437. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7438. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7439. begin
  7440. aVec[0] := aHalfSize;
  7441. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7442. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7443. end;
  7444. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7445. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7446. begin
  7447. aVec[0] := - aHalfSize;
  7448. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7449. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7450. end;
  7451. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7452. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7453. begin
  7454. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7455. aVec[1] := aHalfSize;
  7456. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7457. end;
  7458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7459. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7460. begin
  7461. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7462. aVec[1] := - aHalfSize;
  7463. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7464. end;
  7465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7466. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7467. begin
  7468. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7469. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7470. aVec[2] := aHalfSize;
  7471. end;
  7472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7473. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7474. begin
  7475. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7476. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7477. aVec[2] := - aHalfSize;
  7478. end;
  7479. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7480. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7481. var
  7482. i: Integer;
  7483. Vec: TVec;
  7484. Len: Single;
  7485. begin
  7486. with FuncRec do begin
  7487. with PglBitmapNormalMapRec(Args)^ do begin
  7488. Func(Vec, Position, HalfSize);
  7489. // Normalize
  7490. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7491. if Len <> 0 then begin
  7492. Vec[0] := Vec[0] * Len;
  7493. Vec[1] := Vec[1] * Len;
  7494. Vec[2] := Vec[2] * Len;
  7495. end;
  7496. // Scale Vector and AddVectro
  7497. Vec[0] := Vec[0] * 0.5 + 0.5;
  7498. Vec[1] := Vec[1] * 0.5 + 0.5;
  7499. Vec[2] := Vec[2] * 0.5 + 0.5;
  7500. end;
  7501. // Set Color
  7502. for i := 0 to 2 do
  7503. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7504. end;
  7505. end;
  7506. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7507. procedure TglBitmapNormalMap.AfterConstruction;
  7508. begin
  7509. inherited;
  7510. fGenMode := GL_NORMAL_MAP;
  7511. end;
  7512. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7513. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7514. var
  7515. Rec: TglBitmapNormalMapRec;
  7516. SizeRec: TglBitmapPixelPosition;
  7517. begin
  7518. Rec.HalfSize := aSize div 2;
  7519. FreeDataAfterGenTexture := false;
  7520. SizeRec.Fields := [ffX, ffY];
  7521. SizeRec.X := aSize;
  7522. SizeRec.Y := aSize;
  7523. // Positive X
  7524. Rec.Func := glBitmapNormalMapPosX;
  7525. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7526. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7527. // Negative X
  7528. Rec.Func := glBitmapNormalMapNegX;
  7529. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7530. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7531. // Positive Y
  7532. Rec.Func := glBitmapNormalMapPosY;
  7533. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7534. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7535. // Negative Y
  7536. Rec.Func := glBitmapNormalMapNegY;
  7537. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7538. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7539. // Positive Z
  7540. Rec.Func := glBitmapNormalMapPosZ;
  7541. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7542. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7543. // Negative Z
  7544. Rec.Func := glBitmapNormalMapNegZ;
  7545. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7546. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7547. end;
  7548. initialization
  7549. glBitmapSetDefaultFormat (tfEmpty);
  7550. glBitmapSetDefaultMipmap (mmMipmap);
  7551. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7552. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7553. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7554. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7555. glBitmapSetDefaultDeleteTextureOnFree (true);
  7556. TFormatDescriptor.Init;
  7557. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7558. OpenGLInitialized := false;
  7559. InitOpenGLCS := TCriticalSection.Create;
  7560. {$ENDIF}
  7561. finalization
  7562. TFormatDescriptor.Finalize;
  7563. {$IFDEF GLB_NATIVE_OGL}
  7564. if Assigned(GL_LibHandle) then
  7565. glbFreeLibrary(GL_LibHandle);
  7566. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7567. if Assigned(GLU_LibHandle) then
  7568. glbFreeLibrary(GLU_LibHandle);
  7569. FreeAndNil(InitOpenGLCS);
  7570. {$ENDIF}
  7571. {$ENDIF}
  7572. end.