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.

8624 lines
297 KiB

  1. {***********************************************************
  2. glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  3. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  4. modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
  5. ------------------------------------------------------------
  6. The contents of this file are used with permission, subject to
  7. the Mozilla Public License Version 1.1 (the "License"); you may
  8. not use this file except in compliance with the License. You may
  9. obtain a copy of the License at
  10. http://www.mozilla.org/MPL/MPL-1.1.html
  11. ------------------------------------------------------------
  12. Version 3.0.0 unstable
  13. ------------------------------------------------------------
  14. History
  15. 20-11-2013
  16. - refactoring of the complete library
  17. 21-03-2010
  18. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  19. then it's your problem if that isn't true. This prevents the unit for incompatibility
  20. with newer versions of Delphi.
  21. - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  22. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  23. 10-08-2008
  24. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  25. - Additional Datapointer for functioninterface now has the name CustomData
  26. 24-07-2008
  27. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  28. - If you load an texture from an file the property Filename will be set to the name of the file
  29. - Three new properties to attach custom data to the Texture objects
  30. - CustomName (free for use string)
  31. - CustomNameW (free for use widestring)
  32. - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  33. 27-05-2008
  34. - RLE TGAs loaded much faster
  35. 26-05-2008
  36. - fixed some problem with reading RLE TGAs.
  37. 21-05-2008
  38. - function clone now only copys data if it's assigned and now it also copies the ID
  39. - it seems that lazarus dont like comments in comments.
  40. 01-05-2008
  41. - It's possible to set the id of the texture
  42. - define GLB_NO_NATIVE_GL deactivated by default
  43. 27-04-2008
  44. - Now supports the following libraries
  45. - SDL and SDL_image
  46. - libPNG
  47. - libJPEG
  48. - Linux compatibillity via free pascal compatibility (delphi sources optional)
  49. - BMPs now loaded manuel
  50. - Large restructuring
  51. - Property DataPtr now has the name Data
  52. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  53. - Unused Depth removed
  54. - Function FreeData to freeing image data added
  55. 24-10-2007
  56. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  57. 15-11-2006
  58. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  59. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  60. - Function ReadOpenGLExtension is now only intern
  61. 29-06-2006
  62. - pngimage now disabled by default like all other versions.
  63. 26-06-2006
  64. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  65. 22-06-2006
  66. - Fixed some Problem with Delphi 5
  67. - Now uses the newest version of pngimage. Makes saving pngs much easier.
  68. 22-03-2006
  69. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  70. 09-03-2006
  71. - Internal Format ifDepth8 added
  72. - function GrabScreen now supports all uncompressed formats
  73. 31-01-2006
  74. - AddAlphaFromglBitmap implemented
  75. 29-12-2005
  76. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  77. 28-12-2005
  78. - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  79. property Width, Height, Depth are still existing and new property Dimension are avail
  80. 11-12-2005
  81. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  82. 19-10-2005
  83. - Added function GrabScreen to class TglBitmap2D
  84. 18-10-2005
  85. - Added support to Save images
  86. - Added function Clone to Clone Instance
  87. 11-10-2005
  88. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  89. Usefull for Future
  90. - Several speed optimizations
  91. 09-10-2005
  92. - Internal structure change. Loading of TGA, PNG and DDS improved.
  93. Data, format and size will now set directly with SetDataPtr.
  94. - AddFunc now works with all Types of Images and Formats
  95. - Some Funtions moved to Baseclass TglBitmap
  96. 06-10-2005
  97. - Added Support to decompress DXT3 and DXT5 compressed Images.
  98. - Added Mapping to convert data from one format into an other.
  99. 05-10-2005
  100. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  101. supported Input format (supported by GetPixel) into any uncompresed Format
  102. - Added Support to decompress DXT1 compressed Images.
  103. - SwapColors replaced by ConvertTo
  104. 04-10-2005
  105. - Added Support for compressed DDSs
  106. - Added new internal formats (DXT1, DXT3, DXT5)
  107. 29-09-2005
  108. - Parameter Components renamed to InternalFormat
  109. 23-09-2005
  110. - Some AllocMem replaced with GetMem (little speed change)
  111. - better exception handling. Better protection from memory leaks.
  112. 22-09-2005
  113. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
  114. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
  115. 07-09-2005
  116. - Added support for Grayscale textures
  117. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
  118. 10-07-2005
  119. - Added support for GL_VERSION_2_0
  120. - Added support for GL_EXT_texture_filter_anisotropic
  121. 04-07-2005
  122. - Function FillWithColor fills the Image with one Color
  123. - Function LoadNormalMap added
  124. 30-06-2005
  125. - ToNormalMap allows to Create an NormalMap from the Alphachannel
  126. - ToNormalMap now supports Sobel (nmSobel) function.
  127. 29-06-2005
  128. - support for RLE Compressed RGB TGAs added
  129. 28-06-2005
  130. - Class TglBitmapNormalMap added to support Normalmap generation
  131. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
  132. 3 Filters are supported. (4 Samples, 3x3 and 5x5)
  133. 16-06-2005
  134. - Method LoadCubeMapClass removed
  135. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
  136. - virtual abstract method GenTexture in class TglBitmap now is protected
  137. 12-06-2005
  138. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
  139. 10-06-2005
  140. - little enhancement for IsPowerOfTwo
  141. - TglBitmap1D.GenTexture now tests NPOT Textures
  142. 06-06-2005
  143. - some little name changes. All properties or function with Texture in name are
  144. now without texture in name. We have allways texture so we dosn't name it.
  145. 03-06-2005
  146. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
  147. TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
  148. 02-06-2005
  149. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
  150. 25-04-2005
  151. - Function Unbind added
  152. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
  153. 21-04-2005
  154. - class TglBitmapCubeMap added (allows to Create Cubemaps)
  155. 29-03-2005
  156. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
  157. To Enable png's use the define pngimage
  158. 22-03-2005
  159. - New Functioninterface added
  160. - Function GetPixel added
  161. 27-11-2004
  162. - Property BuildMipMaps renamed to MipMap
  163. 21-11-2004
  164. - property Name removed.
  165. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
  166. 22-05-2004
  167. - property name added. Only used in glForms!
  168. 26-11-2003
  169. - property FreeDataAfterGenTexture is now available as default (default = true)
  170. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
  171. - function MoveMemory replaced with function Move (little speed change)
  172. - several calculations stored in variables (little speed change)
  173. 29-09-2003
  174. - property BuildMipsMaps added (default = true)
  175. if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
  176. - property FreeDataAfterGenTexture added (default = true)
  177. if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
  178. - parameter DisableOtherTextureUnits of Bind removed
  179. - parameter FreeDataAfterGeneration of GenTextures removed
  180. 12-09-2003
  181. - TglBitmap dosn't delete data if class was destroyed (fixed)
  182. 09-09-2003
  183. - Bind now enables TextureUnits (by params)
  184. - GenTextures can leave data (by param)
  185. - LoadTextures now optimal
  186. 03-09-2003
  187. - Performance optimization in AddFunc
  188. - procedure Bind moved to subclasses
  189. - Added new Class TglBitmap1D to support real OpenGL 1D Textures
  190. 19-08-2003
  191. - Texturefilter and texturewrap now also as defaults
  192. Minfilter = GL_LINEAR_MIPMAP_LINEAR
  193. Magfilter = GL_LINEAR
  194. Wrap(str) = GL_CLAMP_TO_EDGE
  195. - Added new format tfCompressed to create a compressed texture.
  196. - propertys IsCompressed, TextureSize and IsResident added
  197. IsCompressed and TextureSize only contains data from level 0
  198. 18-08-2003
  199. - Added function AddFunc to add PerPixelEffects to Image
  200. - LoadFromFunc now based on AddFunc
  201. - Invert now based on AddFunc
  202. - SwapColors now based on AddFunc
  203. 16-08-2003
  204. - Added function FlipHorz
  205. 15-08-2003
  206. - Added function LaodFromFunc to create images with function
  207. - Added function FlipVert
  208. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
  209. 29-07-2003
  210. - Added Alphafunctions to calculate alpha per function
  211. - Added Alpha from ColorKey using alphafunctions
  212. 28-07-2003
  213. - First full functionally Version of glBitmap
  214. - Support for 24Bit and 32Bit TGA Pictures added
  215. 25-07-2003
  216. - begin of programming
  217. ***********************************************************}
  218. unit glBitmap;
  219. // Please uncomment the defines below to configure the glBitmap to your preferences.
  220. // If you have configured the unit you can uncomment the warning above.
  221. {$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  223. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  225. // activate to enable build-in OpenGL support with statically linked methods
  226. // use dglOpenGL.pas if not enabled
  227. {.$DEFINE GLB_NATIVE_OGL_STATIC}
  228. // activate to enable build-in OpenGL support with dynamically linked methods
  229. // use dglOpenGL.pas if not enabled
  230. {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
  231. // activate to enable the support for SDL_surfaces
  232. {.$DEFINE GLB_SDL}
  233. // activate to enable the support for TBitmap from Delphi (not lazarus)
  234. {.$DEFINE GLB_DELPHI}
  235. // activate to enable the support for TLazIntfImage from Lazarus
  236. {.$DEFINE GLB_LAZARUS}
  237. // activate to enable the support of SDL_image to load files. (READ ONLY)
  238. // If you enable SDL_image all other libraries will be ignored!
  239. {.$DEFINE GLB_SDL_IMAGE}
  240. // activate to enable Lazarus TPortableNetworkGraphic support
  241. // if you enable this pngImage and libPNG will be ignored
  242. {.$DEFINE GLB_LAZ_PNG}
  243. // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
  244. // if you enable pngimage the libPNG will be ignored
  245. {.$DEFINE GLB_PNGIMAGE}
  246. // activate to use the libPNG -> http://www.libpng.org/
  247. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
  248. {.$DEFINE GLB_LIB_PNG}
  249. // activate to enable Lazarus TJPEGImage support
  250. // if you enable this delphi jpegs and libJPEG will be ignored
  251. {.$DEFINE GLB_LAZ_JPEG}
  252. // if you enable delphi jpegs the libJPEG will be ignored
  253. {.$DEFINE GLB_DELPHI_JPEG}
  254. // activate to use the libJPEG -> http://www.ijg.org/
  255. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
  256. {.$DEFINE GLB_LIB_JPEG}
  257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  258. // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  259. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  260. // Delphi Versions
  261. {$IFDEF fpc}
  262. {$MODE Delphi}
  263. {$IFDEF CPUI386}
  264. {$DEFINE CPU386}
  265. {$ASMMODE INTEL}
  266. {$ENDIF}
  267. {$IFNDEF WINDOWS}
  268. {$linklib c}
  269. {$ENDIF}
  270. {$ENDIF}
  271. // Operation System
  272. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  273. {$DEFINE GLB_WIN}
  274. {$ELSEIF DEFINED(LINUX)}
  275. {$DEFINE GLB_LINUX}
  276. {$IFEND}
  277. // native OpenGL Support
  278. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  279. {$DEFINE GLB_NATIVE_OGL}
  280. {$IFEND}
  281. // checking define combinations
  282. //SDL Image
  283. {$IFDEF GLB_SDL_IMAGE}
  284. {$IFNDEF GLB_SDL}
  285. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  286. {$DEFINE GLB_SDL}
  287. {$ENDIF}
  288. {$IFDEF GLB_LAZ_PNG}
  289. {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  290. {$undef GLB_LAZ_PNG}
  291. {$ENDIF}
  292. {$IFDEF GLB_PNGIMAGE}
  293. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  294. {$undef GLB_PNGIMAGE}
  295. {$ENDIF}
  296. {$IFDEF GLB_LAZ_JPEG}
  297. {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  298. {$undef GLB_LAZ_JPEG}
  299. {$ENDIF}
  300. {$IFDEF GLB_DELPHI_JPEG}
  301. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  302. {$undef GLB_DELPHI_JPEG}
  303. {$ENDIF}
  304. {$IFDEF GLB_LIB_PNG}
  305. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  306. {$undef GLB_LIB_PNG}
  307. {$ENDIF}
  308. {$IFDEF GLB_LIB_JPEG}
  309. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  310. {$undef GLB_LIB_JPEG}
  311. {$ENDIF}
  312. {$DEFINE GLB_SUPPORT_PNG_READ}
  313. {$DEFINE GLB_SUPPORT_JPEG_READ}
  314. {$ENDIF}
  315. // Lazarus TPortableNetworkGraphic
  316. {$IFDEF GLB_LAZ_PNG}
  317. {$IFNDEF GLB_LAZARUS}
  318. {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
  319. {$DEFINE GLB_LAZARUS}
  320. {$ENDIF}
  321. {$IFDEF GLB_PNGIMAGE}
  322. {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  323. {$undef GLB_PNGIMAGE}
  324. {$ENDIF}
  325. {$IFDEF GLB_LIB_PNG}
  326. {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  327. {$undef GLB_LIB_PNG}
  328. {$ENDIF}
  329. {$DEFINE GLB_SUPPORT_PNG_READ}
  330. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  331. {$ENDIF}
  332. // PNG Image
  333. {$IFDEF GLB_PNGIMAGE}
  334. {$IFDEF GLB_LIB_PNG}
  335. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  336. {$undef GLB_LIB_PNG}
  337. {$ENDIF}
  338. {$DEFINE GLB_SUPPORT_PNG_READ}
  339. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  340. {$ENDIF}
  341. // libPNG
  342. {$IFDEF GLB_LIB_PNG}
  343. {$DEFINE GLB_SUPPORT_PNG_READ}
  344. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  345. {$ENDIF}
  346. // Lazarus TJPEGImage
  347. {$IFDEF GLB_LAZ_JPEG}
  348. {$IFNDEF GLB_LAZARUS}
  349. {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
  350. {$DEFINE GLB_LAZARUS}
  351. {$ENDIF}
  352. {$IFDEF GLB_DELPHI_JPEG}
  353. {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
  354. {$undef GLB_DELPHI_JPEG}
  355. {$ENDIF}
  356. {$IFDEF GLB_LIB_JPEG}
  357. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
  358. {$undef GLB_LIB_JPEG}
  359. {$ENDIF}
  360. {$DEFINE GLB_SUPPORT_JPEG_READ}
  361. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  362. {$ENDIF}
  363. // JPEG Image
  364. {$IFDEF GLB_DELPHI_JPEG}
  365. {$IFDEF GLB_LIB_JPEG}
  366. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  367. {$undef GLB_LIB_JPEG}
  368. {$ENDIF}
  369. {$DEFINE GLB_SUPPORT_JPEG_READ}
  370. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  371. {$ENDIF}
  372. // libJPEG
  373. {$IFDEF GLB_LIB_JPEG}
  374. {$DEFINE GLB_SUPPORT_JPEG_READ}
  375. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  376. {$ENDIF}
  377. // native OpenGL
  378. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  379. {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
  380. {$IFEND}
  381. // general options
  382. {$EXTENDEDSYNTAX ON}
  383. {$LONGSTRINGS ON}
  384. {$ALIGN ON}
  385. {$IFNDEF FPC}
  386. {$OPTIMIZATION ON}
  387. {$ENDIF}
  388. interface
  389. uses
  390. {$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
  391. {$IF DEFINED(GLB_WIN) AND
  392. (DEFINED(GLB_NATIVE_OGL) OR
  393. DEFINED(GLB_DELPHI))} windows, {$IFEND}
  394. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  395. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  396. {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$ENDIF}
  397. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  398. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  399. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  400. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  401. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  402. Classes, SysUtils;
  403. {$IFDEF GLB_NATIVE_OGL}
  404. const
  405. GL_TRUE = 1;
  406. GL_FALSE = 0;
  407. GL_ZERO = 0;
  408. GL_ONE = 1;
  409. GL_VERSION = $1F02;
  410. GL_EXTENSIONS = $1F03;
  411. GL_TEXTURE_1D = $0DE0;
  412. GL_TEXTURE_2D = $0DE1;
  413. GL_TEXTURE_RECTANGLE = $84F5;
  414. GL_NORMAL_MAP = $8511;
  415. GL_TEXTURE_CUBE_MAP = $8513;
  416. GL_REFLECTION_MAP = $8512;
  417. GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
  418. GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
  419. GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
  420. GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
  421. GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
  422. GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
  423. GL_TEXTURE_WIDTH = $1000;
  424. GL_TEXTURE_HEIGHT = $1001;
  425. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  426. GL_TEXTURE_SWIZZLE_RGBA = $8E46;
  427. GL_S = $2000;
  428. GL_T = $2001;
  429. GL_R = $2002;
  430. GL_Q = $2003;
  431. GL_TEXTURE_GEN_S = $0C60;
  432. GL_TEXTURE_GEN_T = $0C61;
  433. GL_TEXTURE_GEN_R = $0C62;
  434. GL_TEXTURE_GEN_Q = $0C63;
  435. GL_RED = $1903;
  436. GL_GREEN = $1904;
  437. GL_BLUE = $1905;
  438. GL_ALPHA = $1906;
  439. GL_ALPHA4 = $803B;
  440. GL_ALPHA8 = $803C;
  441. GL_ALPHA12 = $803D;
  442. GL_ALPHA16 = $803E;
  443. GL_LUMINANCE = $1909;
  444. GL_LUMINANCE4 = $803F;
  445. GL_LUMINANCE8 = $8040;
  446. GL_LUMINANCE12 = $8041;
  447. GL_LUMINANCE16 = $8042;
  448. GL_LUMINANCE_ALPHA = $190A;
  449. GL_LUMINANCE4_ALPHA4 = $8043;
  450. GL_LUMINANCE6_ALPHA2 = $8044;
  451. GL_LUMINANCE8_ALPHA8 = $8045;
  452. GL_LUMINANCE12_ALPHA4 = $8046;
  453. GL_LUMINANCE12_ALPHA12 = $8047;
  454. GL_LUMINANCE16_ALPHA16 = $8048;
  455. GL_RGB = $1907;
  456. GL_BGR = $80E0;
  457. GL_R3_G3_B2 = $2A10;
  458. GL_RGB4 = $804F;
  459. GL_RGB5 = $8050;
  460. GL_RGB565 = $8D62;
  461. GL_RGB8 = $8051;
  462. GL_RGB10 = $8052;
  463. GL_RGB12 = $8053;
  464. GL_RGB16 = $8054;
  465. GL_RGBA = $1908;
  466. GL_BGRA = $80E1;
  467. GL_RGBA2 = $8055;
  468. GL_RGBA4 = $8056;
  469. GL_RGB5_A1 = $8057;
  470. GL_RGBA8 = $8058;
  471. GL_RGB10_A2 = $8059;
  472. GL_RGBA12 = $805A;
  473. GL_RGBA16 = $805B;
  474. GL_DEPTH_COMPONENT = $1902;
  475. GL_DEPTH_COMPONENT16 = $81A5;
  476. GL_DEPTH_COMPONENT24 = $81A6;
  477. GL_DEPTH_COMPONENT32 = $81A7;
  478. GL_COMPRESSED_RGB = $84ED;
  479. GL_COMPRESSED_RGBA = $84EE;
  480. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  481. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  482. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  483. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  484. GL_UNSIGNED_BYTE = $1401;
  485. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  486. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  487. GL_UNSIGNED_SHORT = $1403;
  488. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  489. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  490. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  491. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  492. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  493. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  494. GL_UNSIGNED_INT = $1405;
  495. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  496. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  497. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  498. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  499. { Texture Filter }
  500. GL_TEXTURE_MAG_FILTER = $2800;
  501. GL_TEXTURE_MIN_FILTER = $2801;
  502. GL_NEAREST = $2600;
  503. GL_NEAREST_MIPMAP_NEAREST = $2700;
  504. GL_NEAREST_MIPMAP_LINEAR = $2702;
  505. GL_LINEAR = $2601;
  506. GL_LINEAR_MIPMAP_NEAREST = $2701;
  507. GL_LINEAR_MIPMAP_LINEAR = $2703;
  508. { Texture Wrap }
  509. GL_TEXTURE_WRAP_S = $2802;
  510. GL_TEXTURE_WRAP_T = $2803;
  511. GL_TEXTURE_WRAP_R = $8072;
  512. GL_CLAMP = $2900;
  513. GL_REPEAT = $2901;
  514. GL_CLAMP_TO_EDGE = $812F;
  515. GL_CLAMP_TO_BORDER = $812D;
  516. GL_MIRRORED_REPEAT = $8370;
  517. { Other }
  518. GL_GENERATE_MIPMAP = $8191;
  519. GL_TEXTURE_BORDER_COLOR = $1004;
  520. GL_MAX_TEXTURE_SIZE = $0D33;
  521. GL_PACK_ALIGNMENT = $0D05;
  522. GL_UNPACK_ALIGNMENT = $0CF5;
  523. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  524. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  525. GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
  526. GL_TEXTURE_GEN_MODE = $2500;
  527. {$IF DEFINED(GLB_WIN)}
  528. libglu = 'glu32.dll';
  529. libopengl = 'opengl32.dll';
  530. {$ELSEIF DEFINED(GLB_LINUX)}
  531. libglu = 'libGLU.so.1';
  532. libopengl = 'libGL.so.1';
  533. {$IFEND}
  534. type
  535. GLboolean = BYTEBOOL;
  536. GLint = Integer;
  537. GLsizei = Integer;
  538. GLuint = Cardinal;
  539. GLfloat = Single;
  540. GLenum = Cardinal;
  541. PGLvoid = Pointer;
  542. PGLboolean = ^GLboolean;
  543. PGLint = ^GLint;
  544. PGLuint = ^GLuint;
  545. PGLfloat = ^GLfloat;
  546. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  547. TglCompressedTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  548. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  549. {$IF DEFINED(GLB_WIN)}
  550. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  551. {$ELSEIF DEFINED(GLB_LINUX)}
  552. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  553. TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
  554. {$IFEND}
  555. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  556. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  557. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  558. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  559. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  560. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  561. TglTexParameteriv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  562. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  563. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  564. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  565. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  566. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  567. TglTexGeni = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  568. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  569. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  570. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  571. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  572. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  573. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  574. TglTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  575. TglTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  576. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  577. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  578. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  579. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  580. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  581. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  582. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  583. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  584. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  585. procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  586. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  587. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  588. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  589. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  590. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  591. procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  592. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  593. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  594. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  595. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  596. procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  597. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  598. procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  599. procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  600. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  601. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  602. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  603. {$IFEND}
  604. var
  605. GL_VERSION_1_2,
  606. GL_VERSION_1_3,
  607. GL_VERSION_1_4,
  608. GL_VERSION_2_0,
  609. GL_VERSION_3_3,
  610. GL_SGIS_generate_mipmap,
  611. GL_ARB_texture_border_clamp,
  612. GL_ARB_texture_mirrored_repeat,
  613. GL_ARB_texture_rectangle,
  614. GL_ARB_texture_non_power_of_two,
  615. GL_ARB_texture_swizzle,
  616. GL_ARB_texture_cube_map,
  617. GL_IBM_texture_mirrored_repeat,
  618. GL_NV_texture_rectangle,
  619. GL_EXT_texture_edge_clamp,
  620. GL_EXT_texture_rectangle,
  621. GL_EXT_texture_swizzle,
  622. GL_EXT_texture_cube_map,
  623. GL_EXT_texture_filter_anisotropic: Boolean;
  624. glCompressedTexImage1D: TglCompressedTexImage1D;
  625. glCompressedTexImage2D: TglCompressedTexImage2D;
  626. glGetCompressedTexImage: TglGetCompressedTexImage;
  627. {$IF DEFINED(GLB_WIN)}
  628. wglGetProcAddress: TwglGetProcAddress;
  629. {$ELSEIF DEFINED(GLB_LINUX)}
  630. glXGetProcAddress: TglXGetProcAddress;
  631. glXGetProcAddressARB: TglXGetProcAddress;
  632. {$IFEND}
  633. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  634. glEnable: TglEnable;
  635. glDisable: TglDisable;
  636. glGetString: TglGetString;
  637. glGetIntegerv: TglGetIntegerv;
  638. glTexParameteri: TglTexParameteri;
  639. glTexParameteriv: TglTexParameteriv;
  640. glTexParameterfv: TglTexParameterfv;
  641. glGetTexParameteriv: TglGetTexParameteriv;
  642. glGetTexParameterfv: TglGetTexParameterfv;
  643. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  644. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  645. glTexGeni: TglTexGeni;
  646. glGenTextures: TglGenTextures;
  647. glBindTexture: TglBindTexture;
  648. glDeleteTextures: TglDeleteTextures;
  649. glAreTexturesResident: TglAreTexturesResident;
  650. glReadPixels: TglReadPixels;
  651. glPixelStorei: TglPixelStorei;
  652. glTexImage1D: TglTexImage1D;
  653. glTexImage2D: TglTexImage2D;
  654. glGetTexImage: TglGetTexImage;
  655. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  656. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  657. {$ENDIF}
  658. {$ENDIF}
  659. type
  660. ////////////////////////////////////////////////////////////////////////////////////////////////////
  661. TglBitmapFormat = (
  662. tfEmpty = 0, //must be smallest value!
  663. tfAlpha4,
  664. tfAlpha8,
  665. tfAlpha12,
  666. tfAlpha16,
  667. tfLuminance4,
  668. tfLuminance8,
  669. tfLuminance12,
  670. tfLuminance16,
  671. tfLuminance4Alpha4,
  672. tfLuminance6Alpha2,
  673. tfLuminance8Alpha8,
  674. tfLuminance12Alpha4,
  675. tfLuminance12Alpha12,
  676. tfLuminance16Alpha16,
  677. tfR3G3B2,
  678. tfRGB4,
  679. tfR5G6B5,
  680. tfRGB5,
  681. tfRGB8,
  682. tfRGB10,
  683. tfRGB12,
  684. tfRGB16,
  685. tfRGBA2,
  686. tfRGBA4,
  687. tfRGB5A1,
  688. tfRGBA8,
  689. tfRGB10A2,
  690. tfRGBA12,
  691. tfRGBA16,
  692. tfBGR4,
  693. tfB5G6R5,
  694. tfBGR5,
  695. tfBGR8,
  696. tfBGR10,
  697. tfBGR12,
  698. tfBGR16,
  699. tfBGRA2,
  700. tfBGRA4,
  701. tfBGR5A1,
  702. tfBGRA8,
  703. tfBGR10A2,
  704. tfBGRA12,
  705. tfBGRA16,
  706. tfDepth16,
  707. tfDepth24,
  708. tfDepth32,
  709. tfS3tcDtx1RGBA,
  710. tfS3tcDtx3RGBA,
  711. tfS3tcDtx5RGBA
  712. );
  713. TglBitmapFileType = (
  714. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  715. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  716. ftDDS,
  717. ftTGA,
  718. ftBMP);
  719. TglBitmapFileTypes = set of TglBitmapFileType;
  720. TglBitmapMipMap = (
  721. mmNone,
  722. mmMipmap,
  723. mmMipmapGlu);
  724. TglBitmapNormalMapFunc = (
  725. nm4Samples,
  726. nmSobel,
  727. nm3x3,
  728. nm5x5);
  729. ////////////////////////////////////////////////////////////////////////////////////////////////////
  730. EglBitmap = class(Exception);
  731. EglBitmapNotSupported = class(Exception);
  732. EglBitmapSizeToLarge = class(EglBitmap);
  733. EglBitmapNonPowerOfTwo = class(EglBitmap);
  734. EglBitmapUnsupportedFormat = class(EglBitmap)
  735. public
  736. constructor Create(const aFormat: TglBitmapFormat); overload;
  737. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  738. end;
  739. ////////////////////////////////////////////////////////////////////////////////////////////////////
  740. TglBitmapColorRec = packed record
  741. case Integer of
  742. 0: (r, g, b, a: Cardinal);
  743. 1: (arr: array[0..3] of Cardinal);
  744. end;
  745. TglBitmapPixelData = packed record
  746. Data, Range: TglBitmapColorRec;
  747. Format: TglBitmapFormat;
  748. end;
  749. PglBitmapPixelData = ^TglBitmapPixelData;
  750. ////////////////////////////////////////////////////////////////////////////////////////////////////
  751. TglBitmapPixelPositionFields = set of (ffX, ffY);
  752. TglBitmapPixelPosition = record
  753. Fields : TglBitmapPixelPositionFields;
  754. X : Word;
  755. Y : Word;
  756. end;
  757. TglBitmapFormatDescriptor = class(TObject)
  758. protected
  759. function GetIsCompressed: Boolean; virtual; abstract;
  760. function GetHasAlpha: Boolean; virtual; abstract;
  761. function GetglDataFormat: GLenum; virtual; abstract;
  762. function GetglFormat: GLenum; virtual; abstract;
  763. function GetglInternalFormat: GLenum; virtual; abstract;
  764. public
  765. property IsCompressed: Boolean read GetIsCompressed;
  766. property HasAlpha: Boolean read GetHasAlpha;
  767. property glFormat: GLenum read GetglFormat;
  768. property glInternalFormat: GLenum read GetglInternalFormat;
  769. property glDataFormat: GLenum read GetglDataFormat;
  770. end;
  771. ////////////////////////////////////////////////////////////////////////////////////////////////////
  772. TglBitmap = class;
  773. TglBitmapFunctionRec = record
  774. Sender: TglBitmap;
  775. Size: TglBitmapPixelPosition;
  776. Position: TglBitmapPixelPosition;
  777. Source: TglBitmapPixelData;
  778. Dest: TglBitmapPixelData;
  779. Args: Pointer;
  780. end;
  781. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  782. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  783. TglBitmap = class
  784. private
  785. function GetFormatDesc: TglBitmapFormatDescriptor;
  786. protected
  787. fID: GLuint;
  788. fTarget: GLuint;
  789. fAnisotropic: Integer;
  790. fDeleteTextureOnFree: Boolean;
  791. fFreeDataOnDestroy: Boolean;
  792. fFreeDataAfterGenTexture: Boolean;
  793. fData: PByte;
  794. fIsResident: Boolean;
  795. fBorderColor: array[0..3] of Single;
  796. fDimension: TglBitmapPixelPosition;
  797. fMipMap: TglBitmapMipMap;
  798. fFormat: TglBitmapFormat;
  799. // Mapping
  800. fPixelSize: Integer;
  801. fRowSize: Integer;
  802. // Filtering
  803. fFilterMin: GLenum;
  804. fFilterMag: GLenum;
  805. // TexturWarp
  806. fWrapS: GLenum;
  807. fWrapT: GLenum;
  808. fWrapR: GLenum;
  809. //Swizzle
  810. fSwizzle: array[0..3] of GLenum;
  811. // CustomData
  812. fFilename: String;
  813. fCustomName: String;
  814. fCustomNameW: WideString;
  815. fCustomData: Pointer;
  816. //Getter
  817. function GetWidth: Integer; virtual;
  818. function GetHeight: Integer; virtual;
  819. function GetFileWidth: Integer; virtual;
  820. function GetFileHeight: Integer; virtual;
  821. //Setter
  822. procedure SetCustomData(const aValue: Pointer);
  823. procedure SetCustomName(const aValue: String);
  824. procedure SetCustomNameW(const aValue: WideString);
  825. procedure SetFreeDataOnDestroy(const aValue: Boolean);
  826. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  827. procedure SetFormat(const aValue: TglBitmapFormat);
  828. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  829. procedure SetID(const aValue: Cardinal);
  830. procedure SetMipMap(const aValue: TglBitmapMipMap);
  831. procedure SetTarget(const aValue: Cardinal);
  832. procedure SetAnisotropic(const aValue: Integer);
  833. procedure CreateID;
  834. procedure SetupParameters(out aBuildWithGlu: Boolean);
  835. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  836. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method
  837. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  838. function FlipHorz: Boolean; virtual;
  839. function FlipVert: Boolean; virtual;
  840. property Width: Integer read GetWidth;
  841. property Height: Integer read GetHeight;
  842. property FileWidth: Integer read GetFileWidth;
  843. property FileHeight: Integer read GetFileHeight;
  844. public
  845. //Properties
  846. property ID: Cardinal read fID write SetID;
  847. property Target: Cardinal read fTarget write SetTarget;
  848. property Format: TglBitmapFormat read fFormat write SetFormat;
  849. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  850. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  851. property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc;
  852. property Filename: String read fFilename;
  853. property CustomName: String read fCustomName write SetCustomName;
  854. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  855. property CustomData: Pointer read fCustomData write SetCustomData;
  856. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  857. property FreeDataOnDestroy: Boolean read fFreeDataOnDestroy write SetFreeDataOnDestroy;
  858. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  859. property Dimension: TglBitmapPixelPosition read fDimension;
  860. property Data: PByte read fData;
  861. property IsResident: Boolean read fIsResident;
  862. procedure AfterConstruction; override;
  863. procedure BeforeDestruction; override;
  864. procedure PrepareResType(var aResource: String; var aResType: PChar);
  865. //Load
  866. procedure LoadFromFile(const aFilename: String);
  867. procedure LoadFromStream(const aStream: TStream); virtual;
  868. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  869. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  870. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  871. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  872. //Save
  873. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  874. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  875. //Convert
  876. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  877. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  878. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  879. public
  880. //Alpha & Co
  881. {$IFDEF GLB_SDL}
  882. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  883. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  884. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  885. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  886. const aArgs: Pointer = nil): Boolean;
  887. {$ENDIF}
  888. {$IFDEF GLB_DELPHI}
  889. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  890. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  891. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  892. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  893. const aArgs: Pointer = nil): Boolean;
  894. {$ENDIF}
  895. {$IFDEF GLB_LAZARUS}
  896. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  897. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  898. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  899. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  900. const aArgs: Pointer = nil): Boolean;
  901. {$ENDIF}
  902. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  903. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  904. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  905. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  906. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  907. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  908. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  909. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  910. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  911. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  912. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  913. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  914. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  915. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  916. function RemoveAlpha: Boolean; virtual;
  917. public
  918. //Common
  919. function Clone: TglBitmap;
  920. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  921. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  922. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  923. procedure FreeData;
  924. //ColorFill
  925. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  926. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  927. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  928. //TexParameters
  929. procedure SetFilter(const aMin, aMag: GLenum);
  930. procedure SetWrap(
  931. const S: GLenum = GL_CLAMP_TO_EDGE;
  932. const T: GLenum = GL_CLAMP_TO_EDGE;
  933. const R: GLenum = GL_CLAMP_TO_EDGE);
  934. procedure SetSwizzle(const r, g, b, a: GLenum);
  935. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  936. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  937. //Constructors
  938. constructor Create; overload;
  939. constructor Create(const aFileName: String); overload;
  940. constructor Create(const aStream: TStream); overload;
  941. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  942. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  943. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  944. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  945. private
  946. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  947. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  948. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  949. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  950. function LoadBMP(const aStream: TStream): Boolean; virtual;
  951. procedure SaveBMP(const aStream: TStream); virtual;
  952. function LoadTGA(const aStream: TStream): Boolean; virtual;
  953. procedure SaveTGA(const aStream: TStream); virtual;
  954. function LoadDDS(const aStream: TStream): Boolean; virtual;
  955. procedure SaveDDS(const aStream: TStream); virtual;
  956. end;
  957. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  958. TglBitmap1D = class(TglBitmap)
  959. protected
  960. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  961. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  962. procedure UploadData(const aBuildWithGlu: Boolean);
  963. public
  964. property Width;
  965. procedure AfterConstruction; override;
  966. function FlipHorz: Boolean; override;
  967. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  968. end;
  969. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  970. TglBitmap2D = class(TglBitmap)
  971. protected
  972. fLines: array of PByte;
  973. function GetScanline(const aIndex: Integer): Pointer;
  974. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  975. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  976. procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  977. public
  978. property Width;
  979. property Height;
  980. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  981. procedure AfterConstruction; override;
  982. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  983. procedure GetDataFromTexture;
  984. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  985. function FlipHorz: Boolean; override;
  986. function FlipVert: Boolean; override;
  987. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  988. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  989. end;
  990. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  991. TglBitmapCubeMap = class(TglBitmap2D)
  992. protected
  993. fGenMode: Integer;
  994. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  995. public
  996. procedure AfterConstruction; override;
  997. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  998. procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  999. procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  1000. end;
  1001. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1002. TglBitmapNormalMap = class(TglBitmapCubeMap)
  1003. public
  1004. procedure AfterConstruction; override;
  1005. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  1006. end;
  1007. const
  1008. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1009. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1010. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1011. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1012. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1013. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1014. procedure glBitmapSetDefaultWrap(
  1015. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1016. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1017. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1018. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1019. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1020. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1021. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1022. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1023. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1024. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1025. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1026. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1027. var
  1028. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1029. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1030. glBitmapDefaultFormat: TglBitmapFormat;
  1031. glBitmapDefaultMipmap: TglBitmapMipMap;
  1032. glBitmapDefaultFilterMin: Cardinal;
  1033. glBitmapDefaultFilterMag: Cardinal;
  1034. glBitmapDefaultWrapS: Cardinal;
  1035. glBitmapDefaultWrapT: Cardinal;
  1036. glBitmapDefaultWrapR: Cardinal;
  1037. glDefaultSwizzle: array[0..3] of GLenum;
  1038. {$IFDEF GLB_DELPHI}
  1039. function CreateGrayPalette: HPALETTE;
  1040. {$ENDIF}
  1041. implementation
  1042. uses
  1043. Math, syncobjs, typinfo
  1044. {$IFDEF GLB_DELPHI}, Types{$ENDIF}
  1045. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1046. type
  1047. {$IFNDEF fpc}
  1048. QWord = System.UInt64;
  1049. PQWord = ^QWord;
  1050. PtrInt = Longint;
  1051. PtrUInt = DWord;
  1052. {$ENDIF}
  1053. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1054. TShiftRec = packed record
  1055. case Integer of
  1056. 0: (r, g, b, a: Byte);
  1057. 1: (arr: array[0..3] of Byte);
  1058. end;
  1059. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1060. private
  1061. function GetRedMask: QWord;
  1062. function GetGreenMask: QWord;
  1063. function GetBlueMask: QWord;
  1064. function GetAlphaMask: QWord;
  1065. protected
  1066. fFormat: TglBitmapFormat;
  1067. fWithAlpha: TglBitmapFormat;
  1068. fWithoutAlpha: TglBitmapFormat;
  1069. fRGBInverted: TglBitmapFormat;
  1070. fUncompressed: TglBitmapFormat;
  1071. fPixelSize: Single;
  1072. fIsCompressed: Boolean;
  1073. fRange: TglBitmapColorRec;
  1074. fShift: TShiftRec;
  1075. fglFormat: GLenum;
  1076. fglInternalFormat: GLenum;
  1077. fglDataFormat: GLenum;
  1078. function GetIsCompressed: Boolean; override;
  1079. function GetHasAlpha: Boolean; override;
  1080. function GetglFormat: GLenum; override;
  1081. function GetglInternalFormat: GLenum; override;
  1082. function GetglDataFormat: GLenum; override;
  1083. function GetComponents: Integer; virtual;
  1084. public
  1085. property Format: TglBitmapFormat read fFormat;
  1086. property WithAlpha: TglBitmapFormat read fWithAlpha;
  1087. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  1088. property RGBInverted: TglBitmapFormat read fRGBInverted;
  1089. property Components: Integer read GetComponents;
  1090. property PixelSize: Single read fPixelSize;
  1091. property Range: TglBitmapColorRec read fRange;
  1092. property Shift: TShiftRec read fShift;
  1093. property RedMask: QWord read GetRedMask;
  1094. property GreenMask: QWord read GetGreenMask;
  1095. property BlueMask: QWord read GetBlueMask;
  1096. property AlphaMask: QWord read GetAlphaMask;
  1097. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1098. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1099. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1100. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1101. function CreateMappingData: Pointer; virtual;
  1102. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1103. function IsEmpty: Boolean; virtual;
  1104. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  1105. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1106. constructor Create; virtual;
  1107. public
  1108. class procedure Init;
  1109. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1110. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1111. class procedure Clear;
  1112. class procedure Finalize;
  1113. end;
  1114. TFormatDescriptorClass = class of TFormatDescriptor;
  1115. TfdEmpty = class(TFormatDescriptor);
  1116. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1117. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1118. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1119. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1120. constructor Create; override;
  1121. end;
  1122. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1123. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1124. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1125. constructor Create; override;
  1126. end;
  1127. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1128. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1129. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1130. constructor Create; override;
  1131. end;
  1132. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1133. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1134. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1135. constructor Create; override;
  1136. end;
  1137. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1138. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1139. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1140. constructor Create; override;
  1141. end;
  1142. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1143. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1144. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1145. constructor Create; override;
  1146. end;
  1147. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1148. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1149. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1150. constructor Create; override;
  1151. end;
  1152. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1153. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1154. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1155. constructor Create; override;
  1156. end;
  1157. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1158. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  1159. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1160. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1161. constructor Create; override;
  1162. end;
  1163. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  1164. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1165. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1166. constructor Create; override;
  1167. end;
  1168. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1169. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1170. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1171. constructor Create; override;
  1172. end;
  1173. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1174. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1175. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1176. constructor Create; override;
  1177. end;
  1178. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1179. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1180. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1181. constructor Create; override;
  1182. end;
  1183. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1184. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1185. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1186. constructor Create; override;
  1187. end;
  1188. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1189. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1190. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1191. constructor Create; override;
  1192. end;
  1193. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1194. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1195. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1196. constructor Create; override;
  1197. end;
  1198. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1199. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1200. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1201. constructor Create; override;
  1202. end;
  1203. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1204. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  1205. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1206. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1207. constructor Create; override;
  1208. end;
  1209. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1210. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1211. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1212. constructor Create; override;
  1213. end;
  1214. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1215. TfdAlpha4 = class(TfdAlpha_UB1)
  1216. constructor Create; override;
  1217. end;
  1218. TfdAlpha8 = class(TfdAlpha_UB1)
  1219. constructor Create; override;
  1220. end;
  1221. TfdAlpha12 = class(TfdAlpha_US1)
  1222. constructor Create; override;
  1223. end;
  1224. TfdAlpha16 = class(TfdAlpha_US1)
  1225. constructor Create; override;
  1226. end;
  1227. TfdLuminance4 = class(TfdLuminance_UB1)
  1228. constructor Create; override;
  1229. end;
  1230. TfdLuminance8 = class(TfdLuminance_UB1)
  1231. constructor Create; override;
  1232. end;
  1233. TfdLuminance12 = class(TfdLuminance_US1)
  1234. constructor Create; override;
  1235. end;
  1236. TfdLuminance16 = class(TfdLuminance_US1)
  1237. constructor Create; override;
  1238. end;
  1239. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1240. constructor Create; override;
  1241. end;
  1242. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1243. constructor Create; override;
  1244. end;
  1245. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1246. constructor Create; override;
  1247. end;
  1248. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1249. constructor Create; override;
  1250. end;
  1251. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1252. constructor Create; override;
  1253. end;
  1254. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1255. constructor Create; override;
  1256. end;
  1257. TfdR3G3B2 = class(TfdUniversal_UB1)
  1258. constructor Create; override;
  1259. end;
  1260. TfdRGB4 = class(TfdUniversal_US1)
  1261. constructor Create; override;
  1262. end;
  1263. TfdR5G6B5 = class(TfdUniversal_US1)
  1264. constructor Create; override;
  1265. end;
  1266. TfdRGB5 = class(TfdUniversal_US1)
  1267. constructor Create; override;
  1268. end;
  1269. TfdRGB8 = class(TfdRGB_UB3)
  1270. constructor Create; override;
  1271. end;
  1272. TfdRGB10 = class(TfdUniversal_UI1)
  1273. constructor Create; override;
  1274. end;
  1275. TfdRGB12 = class(TfdRGB_US3)
  1276. constructor Create; override;
  1277. end;
  1278. TfdRGB16 = class(TfdRGB_US3)
  1279. constructor Create; override;
  1280. end;
  1281. TfdRGBA2 = class(TfdRGBA_UB4)
  1282. constructor Create; override;
  1283. end;
  1284. TfdRGBA4 = class(TfdUniversal_US1)
  1285. constructor Create; override;
  1286. end;
  1287. TfdRGB5A1 = class(TfdUniversal_US1)
  1288. constructor Create; override;
  1289. end;
  1290. TfdRGBA8 = class(TfdRGBA_UB4)
  1291. constructor Create; override;
  1292. end;
  1293. TfdRGB10A2 = class(TfdUniversal_UI1)
  1294. constructor Create; override;
  1295. end;
  1296. TfdRGBA12 = class(TfdRGBA_US4)
  1297. constructor Create; override;
  1298. end;
  1299. TfdRGBA16 = class(TfdRGBA_US4)
  1300. constructor Create; override;
  1301. end;
  1302. TfdBGR4 = class(TfdUniversal_US1)
  1303. constructor Create; override;
  1304. end;
  1305. TfdB5G6R5 = class(TfdUniversal_US1)
  1306. constructor Create; override;
  1307. end;
  1308. TfdBGR5 = class(TfdUniversal_US1)
  1309. constructor Create; override;
  1310. end;
  1311. TfdBGR8 = class(TfdBGR_UB3)
  1312. constructor Create; override;
  1313. end;
  1314. TfdBGR10 = class(TfdUniversal_UI1)
  1315. constructor Create; override;
  1316. end;
  1317. TfdBGR12 = class(TfdBGR_US3)
  1318. constructor Create; override;
  1319. end;
  1320. TfdBGR16 = class(TfdBGR_US3)
  1321. constructor Create; override;
  1322. end;
  1323. TfdBGRA2 = class(TfdBGRA_UB4)
  1324. constructor Create; override;
  1325. end;
  1326. TfdBGRA4 = class(TfdUniversal_US1)
  1327. constructor Create; override;
  1328. end;
  1329. TfdBGR5A1 = class(TfdUniversal_US1)
  1330. constructor Create; override;
  1331. end;
  1332. TfdBGRA8 = class(TfdBGRA_UB4)
  1333. constructor Create; override;
  1334. end;
  1335. TfdBGR10A2 = class(TfdUniversal_UI1)
  1336. constructor Create; override;
  1337. end;
  1338. TfdBGRA12 = class(TfdBGRA_US4)
  1339. constructor Create; override;
  1340. end;
  1341. TfdBGRA16 = class(TfdBGRA_US4)
  1342. constructor Create; override;
  1343. end;
  1344. TfdDepth16 = class(TfdDepth_US1)
  1345. constructor Create; override;
  1346. end;
  1347. TfdDepth24 = class(TfdDepth_UI1)
  1348. constructor Create; override;
  1349. end;
  1350. TfdDepth32 = class(TfdDepth_UI1)
  1351. constructor Create; override;
  1352. end;
  1353. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1354. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1355. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1356. constructor Create; override;
  1357. end;
  1358. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1359. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1360. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1361. constructor Create; override;
  1362. end;
  1363. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1364. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1365. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1366. constructor Create; override;
  1367. end;
  1368. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1369. TbmpBitfieldFormat = class(TFormatDescriptor)
  1370. private
  1371. procedure SetRedMask (const aValue: QWord);
  1372. procedure SetGreenMask(const aValue: QWord);
  1373. procedure SetBlueMask (const aValue: QWord);
  1374. procedure SetAlphaMask(const aValue: QWord);
  1375. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1376. public
  1377. property RedMask: QWord read GetRedMask write SetRedMask;
  1378. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1379. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1380. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1381. property PixelSize: Single read fPixelSize write fPixelSize;
  1382. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1383. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1384. end;
  1385. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1386. TbmpColorTableEnty = packed record
  1387. b, g, r, a: Byte;
  1388. end;
  1389. TbmpColorTable = array of TbmpColorTableEnty;
  1390. TbmpColorTableFormat = class(TFormatDescriptor)
  1391. private
  1392. fColorTable: TbmpColorTable;
  1393. public
  1394. property PixelSize: Single read fPixelSize write fPixelSize;
  1395. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1396. property Range: TglBitmapColorRec read fRange write fRange;
  1397. property Shift: TShiftRec read fShift write fShift;
  1398. property Format: TglBitmapFormat read fFormat write fFormat;
  1399. procedure CreateColorTable;
  1400. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1401. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1402. destructor Destroy; override;
  1403. end;
  1404. const
  1405. LUMINANCE_WEIGHT_R = 0.30;
  1406. LUMINANCE_WEIGHT_G = 0.59;
  1407. LUMINANCE_WEIGHT_B = 0.11;
  1408. ALPHA_WEIGHT_R = 0.30;
  1409. ALPHA_WEIGHT_G = 0.59;
  1410. ALPHA_WEIGHT_B = 0.11;
  1411. DEPTH_WEIGHT_R = 0.333333333;
  1412. DEPTH_WEIGHT_G = 0.333333333;
  1413. DEPTH_WEIGHT_B = 0.333333333;
  1414. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1415. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1416. TfdEmpty,
  1417. TfdAlpha4,
  1418. TfdAlpha8,
  1419. TfdAlpha12,
  1420. TfdAlpha16,
  1421. TfdLuminance4,
  1422. TfdLuminance8,
  1423. TfdLuminance12,
  1424. TfdLuminance16,
  1425. TfdLuminance4Alpha4,
  1426. TfdLuminance6Alpha2,
  1427. TfdLuminance8Alpha8,
  1428. TfdLuminance12Alpha4,
  1429. TfdLuminance12Alpha12,
  1430. TfdLuminance16Alpha16,
  1431. TfdR3G3B2,
  1432. TfdRGB4,
  1433. TfdR5G6B5,
  1434. TfdRGB5,
  1435. TfdRGB8,
  1436. TfdRGB10,
  1437. TfdRGB12,
  1438. TfdRGB16,
  1439. TfdRGBA2,
  1440. TfdRGBA4,
  1441. TfdRGB5A1,
  1442. TfdRGBA8,
  1443. TfdRGB10A2,
  1444. TfdRGBA12,
  1445. TfdRGBA16,
  1446. TfdBGR4,
  1447. TfdB5G6R5,
  1448. TfdBGR5,
  1449. TfdBGR8,
  1450. TfdBGR10,
  1451. TfdBGR12,
  1452. TfdBGR16,
  1453. TfdBGRA2,
  1454. TfdBGRA4,
  1455. TfdBGR5A1,
  1456. TfdBGRA8,
  1457. TfdBGR10A2,
  1458. TfdBGRA12,
  1459. TfdBGRA16,
  1460. TfdDepth16,
  1461. TfdDepth24,
  1462. TfdDepth32,
  1463. TfdS3tcDtx1RGBA,
  1464. TfdS3tcDtx3RGBA,
  1465. TfdS3tcDtx5RGBA
  1466. );
  1467. var
  1468. FormatDescriptorCS: TCriticalSection;
  1469. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1470. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1471. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1472. begin
  1473. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1474. end;
  1475. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1476. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1477. begin
  1478. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1479. end;
  1480. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1481. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1482. begin
  1483. result.Fields := [];
  1484. if X >= 0 then
  1485. result.Fields := result.Fields + [ffX];
  1486. if Y >= 0 then
  1487. result.Fields := result.Fields + [ffY];
  1488. result.X := Max(0, X);
  1489. result.Y := Max(0, Y);
  1490. end;
  1491. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1492. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1493. begin
  1494. result.r := r;
  1495. result.g := g;
  1496. result.b := b;
  1497. result.a := a;
  1498. end;
  1499. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1500. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1501. var
  1502. i: Integer;
  1503. begin
  1504. result := false;
  1505. for i := 0 to high(r1.arr) do
  1506. if (r1.arr[i] <> r2.arr[i]) then
  1507. exit;
  1508. result := true;
  1509. end;
  1510. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1511. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1512. begin
  1513. result.r := r;
  1514. result.g := g;
  1515. result.b := b;
  1516. result.a := a;
  1517. end;
  1518. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1519. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1520. begin
  1521. result := [];
  1522. if (aFormat in [
  1523. //4 bbp
  1524. tfLuminance4,
  1525. //8bpp
  1526. tfR3G3B2, tfLuminance8,
  1527. //16bpp
  1528. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1529. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1530. //24bpp
  1531. tfBGR8, tfRGB8,
  1532. //32bpp
  1533. tfRGB10, tfRGB10A2, tfRGBA8,
  1534. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1535. result := result + [ftBMP];
  1536. if (aFormat in [
  1537. //8 bpp
  1538. tfLuminance8, tfAlpha8,
  1539. //16 bpp
  1540. tfLuminance16, tfLuminance8Alpha8,
  1541. tfRGB5, tfRGB5A1, tfRGBA4,
  1542. tfBGR5, tfBGR5A1, tfBGRA4,
  1543. //24 bpp
  1544. tfRGB8, tfBGR8,
  1545. //32 bpp
  1546. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1547. result := result + [ftTGA];
  1548. if (aFormat in [
  1549. //8 bpp
  1550. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1551. tfR3G3B2, tfRGBA2, tfBGRA2,
  1552. //16 bpp
  1553. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1554. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1555. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1556. //24 bpp
  1557. tfRGB8, tfBGR8,
  1558. //32 bbp
  1559. tfLuminance16Alpha16,
  1560. tfRGBA8, tfRGB10A2,
  1561. tfBGRA8, tfBGR10A2,
  1562. //compressed
  1563. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1564. result := result + [ftDDS];
  1565. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1566. if aFormat in [
  1567. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1568. tfRGB8, tfRGBA8,
  1569. tfBGR8, tfBGRA8] then
  1570. result := result + [ftPNG];
  1571. {$ENDIF}
  1572. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1573. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1574. result := result + [ftJPEG];
  1575. {$ENDIF}
  1576. end;
  1577. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1578. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1579. begin
  1580. while (aNumber and 1) = 0 do
  1581. aNumber := aNumber shr 1;
  1582. result := aNumber = 1;
  1583. end;
  1584. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1585. function GetTopMostBit(aBitSet: QWord): Integer;
  1586. begin
  1587. result := 0;
  1588. while aBitSet > 0 do begin
  1589. inc(result);
  1590. aBitSet := aBitSet shr 1;
  1591. end;
  1592. end;
  1593. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1594. function CountSetBits(aBitSet: QWord): Integer;
  1595. begin
  1596. result := 0;
  1597. while aBitSet > 0 do begin
  1598. if (aBitSet and 1) = 1 then
  1599. inc(result);
  1600. aBitSet := aBitSet shr 1;
  1601. end;
  1602. end;
  1603. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1604. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1605. begin
  1606. result := Trunc(
  1607. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1608. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1609. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1610. end;
  1611. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1612. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1613. begin
  1614. result := Trunc(
  1615. DEPTH_WEIGHT_R * aPixel.Data.r +
  1616. DEPTH_WEIGHT_G * aPixel.Data.g +
  1617. DEPTH_WEIGHT_B * aPixel.Data.b);
  1618. end;
  1619. {$IFDEF GLB_NATIVE_OGL}
  1620. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1621. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1622. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1623. var
  1624. GL_LibHandle: Pointer = nil;
  1625. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
  1626. begin
  1627. if not Assigned(aLibHandle) then
  1628. aLibHandle := GL_LibHandle;
  1629. {$IF DEFINED(GLB_WIN)}
  1630. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1631. if Assigned(result) then
  1632. exit;
  1633. if Assigned(wglGetProcAddress) then
  1634. result := wglGetProcAddress(aProcName);
  1635. {$ELSEIF DEFINED(GLB_LINUX)}
  1636. if Assigned(glXGetProcAddress) then begin
  1637. result := glXGetProcAddress(aProcName);
  1638. if Assigned(result) then
  1639. exit;
  1640. end;
  1641. if Assigned(glXGetProcAddressARB) then begin
  1642. result := glXGetProcAddressARB(aProcName);
  1643. if Assigned(result) then
  1644. exit;
  1645. end;
  1646. result := dlsym(aLibHandle, aProcName);
  1647. {$IFEND}
  1648. if not Assigned(result) and aRaiseOnErr then
  1649. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1650. end;
  1651. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1652. var
  1653. GLU_LibHandle: Pointer = nil;
  1654. OpenGLInitialized: Boolean;
  1655. InitOpenGLCS: TCriticalSection;
  1656. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1657. procedure glbInitOpenGL;
  1658. ////////////////////////////////////////////////////////////////////////////////
  1659. function glbLoadLibrary(const aName: PChar): Pointer;
  1660. begin
  1661. {$IF DEFINED(GLB_WIN)}
  1662. result := {%H-}Pointer(LoadLibrary(aName));
  1663. {$ELSEIF DEFINED(GLB_LINUX)}
  1664. result := dlopen(Name, RTLD_LAZY);
  1665. {$ELSE}
  1666. result := nil;
  1667. {$IFEND}
  1668. end;
  1669. ////////////////////////////////////////////////////////////////////////////////
  1670. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1671. begin
  1672. result := false;
  1673. if not Assigned(aLibHandle) then
  1674. exit;
  1675. {$IF DEFINED(GLB_WIN)}
  1676. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1677. {$ELSEIF DEFINED(GLB_LINUX)}
  1678. Result := dlclose(aLibHandle) = 0;
  1679. {$IFEND}
  1680. end;
  1681. begin
  1682. if Assigned(GL_LibHandle) then
  1683. glbFreeLibrary(GL_LibHandle);
  1684. if Assigned(GLU_LibHandle) then
  1685. glbFreeLibrary(GLU_LibHandle);
  1686. GL_LibHandle := glbLoadLibrary(libopengl);
  1687. if not Assigned(GL_LibHandle) then
  1688. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1689. GLU_LibHandle := glbLoadLibrary(libglu);
  1690. if not Assigned(GLU_LibHandle) then
  1691. raise EglBitmap.Create('unable to load library: ' + libglu);
  1692. {$IF DEFINED(GLB_WIN)}
  1693. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1694. {$ELSEIF DEFINED(GLB_LINUX)}
  1695. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1696. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1697. {$IFEND}
  1698. glEnable := glbGetProcAddress('glEnable');
  1699. glDisable := glbGetProcAddress('glDisable');
  1700. glGetString := glbGetProcAddress('glGetString');
  1701. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1702. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1703. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1704. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1705. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1706. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1707. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1708. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1709. glTexGeni := glbGetProcAddress('glTexGeni');
  1710. glGenTextures := glbGetProcAddress('glGenTextures');
  1711. glBindTexture := glbGetProcAddress('glBindTexture');
  1712. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1713. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1714. glReadPixels := glbGetProcAddress('glReadPixels');
  1715. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1716. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1717. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1718. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1719. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1720. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1721. end;
  1722. {$ENDIF}
  1723. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1724. procedure glbReadOpenGLExtensions;
  1725. var
  1726. Buffer: AnsiString;
  1727. MajorVersion, MinorVersion: Integer;
  1728. ///////////////////////////////////////////////////////////////////////////////////////////
  1729. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1730. var
  1731. Separator: Integer;
  1732. begin
  1733. aMinor := 0;
  1734. aMajor := 0;
  1735. Separator := Pos(AnsiString('.'), aBuffer);
  1736. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1737. (aBuffer[Separator - 1] in ['0'..'9']) and
  1738. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1739. Dec(Separator);
  1740. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1741. Dec(Separator);
  1742. Delete(aBuffer, 1, Separator);
  1743. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1744. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1745. Inc(Separator);
  1746. Delete(aBuffer, Separator, 255);
  1747. Separator := Pos(AnsiString('.'), aBuffer);
  1748. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1749. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1750. end;
  1751. end;
  1752. ///////////////////////////////////////////////////////////////////////////////////////////
  1753. function CheckExtension(const Extension: AnsiString): Boolean;
  1754. var
  1755. ExtPos: Integer;
  1756. begin
  1757. ExtPos := Pos(Extension, Buffer);
  1758. result := ExtPos > 0;
  1759. if result then
  1760. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1761. end;
  1762. ///////////////////////////////////////////////////////////////////////////////////////////
  1763. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1764. begin
  1765. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1766. end;
  1767. begin
  1768. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1769. InitOpenGLCS.Enter;
  1770. try
  1771. if not OpenGLInitialized then begin
  1772. glbInitOpenGL;
  1773. OpenGLInitialized := true;
  1774. end;
  1775. finally
  1776. InitOpenGLCS.Leave;
  1777. end;
  1778. {$ENDIF}
  1779. // Version
  1780. Buffer := glGetString(GL_VERSION);
  1781. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1782. GL_VERSION_1_2 := CheckVersion(1, 2);
  1783. GL_VERSION_1_3 := CheckVersion(1, 3);
  1784. GL_VERSION_1_4 := CheckVersion(1, 4);
  1785. GL_VERSION_2_0 := CheckVersion(2, 0);
  1786. GL_VERSION_3_3 := CheckVersion(3, 3);
  1787. // Extensions
  1788. Buffer := glGetString(GL_EXTENSIONS);
  1789. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1790. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1791. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1792. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1793. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1794. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1795. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1796. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1797. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1798. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1799. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1800. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1801. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1802. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1803. if GL_VERSION_1_3 then begin
  1804. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1805. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1806. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1807. end else begin
  1808. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false);
  1809. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false);
  1810. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
  1811. end;
  1812. end;
  1813. {$ENDIF}
  1814. {$IFDEF GLB_SDL_IMAGE}
  1815. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1816. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1817. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1818. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1819. begin
  1820. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1821. end;
  1822. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1823. begin
  1824. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1825. end;
  1826. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1827. begin
  1828. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1829. end;
  1830. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1831. begin
  1832. result := 0;
  1833. end;
  1834. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1835. begin
  1836. result := SDL_AllocRW;
  1837. if result = nil then
  1838. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1839. result^.seek := glBitmapRWseek;
  1840. result^.read := glBitmapRWread;
  1841. result^.write := glBitmapRWwrite;
  1842. result^.close := glBitmapRWclose;
  1843. result^.unknown.data1 := Stream;
  1844. end;
  1845. {$ENDIF}
  1846. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1847. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1848. begin
  1849. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1850. end;
  1851. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1852. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1853. begin
  1854. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1855. end;
  1856. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1857. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1858. begin
  1859. glBitmapDefaultMipmap := aValue;
  1860. end;
  1861. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1862. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1863. begin
  1864. glBitmapDefaultFormat := aFormat;
  1865. end;
  1866. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1867. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1868. begin
  1869. glBitmapDefaultFilterMin := aMin;
  1870. glBitmapDefaultFilterMag := aMag;
  1871. end;
  1872. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1873. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1874. begin
  1875. glBitmapDefaultWrapS := S;
  1876. glBitmapDefaultWrapT := T;
  1877. glBitmapDefaultWrapR := R;
  1878. end;
  1879. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1880. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1881. begin
  1882. glDefaultSwizzle[0] := r;
  1883. glDefaultSwizzle[1] := g;
  1884. glDefaultSwizzle[2] := b;
  1885. glDefaultSwizzle[3] := a;
  1886. end;
  1887. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1888. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1889. begin
  1890. result := glBitmapDefaultDeleteTextureOnFree;
  1891. end;
  1892. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1893. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1894. begin
  1895. result := glBitmapDefaultFreeDataAfterGenTextures;
  1896. end;
  1897. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1898. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1899. begin
  1900. result := glBitmapDefaultMipmap;
  1901. end;
  1902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1903. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1904. begin
  1905. result := glBitmapDefaultFormat;
  1906. end;
  1907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1908. procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
  1909. begin
  1910. aMin := glBitmapDefaultFilterMin;
  1911. aMag := glBitmapDefaultFilterMag;
  1912. end;
  1913. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1914. procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
  1915. begin
  1916. S := glBitmapDefaultWrapS;
  1917. T := glBitmapDefaultWrapT;
  1918. R := glBitmapDefaultWrapR;
  1919. end;
  1920. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1921. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1922. begin
  1923. r := glDefaultSwizzle[0];
  1924. g := glDefaultSwizzle[1];
  1925. b := glDefaultSwizzle[2];
  1926. a := glDefaultSwizzle[3];
  1927. end;
  1928. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1929. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1930. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1931. function TFormatDescriptor.GetRedMask: QWord;
  1932. begin
  1933. result := fRange.r shl fShift.r;
  1934. end;
  1935. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1936. function TFormatDescriptor.GetGreenMask: QWord;
  1937. begin
  1938. result := fRange.g shl fShift.g;
  1939. end;
  1940. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1941. function TFormatDescriptor.GetBlueMask: QWord;
  1942. begin
  1943. result := fRange.b shl fShift.b;
  1944. end;
  1945. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1946. function TFormatDescriptor.GetAlphaMask: QWord;
  1947. begin
  1948. result := fRange.a shl fShift.a;
  1949. end;
  1950. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1951. function TFormatDescriptor.GetIsCompressed: Boolean;
  1952. begin
  1953. result := fIsCompressed;
  1954. end;
  1955. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1956. function TFormatDescriptor.GetHasAlpha: Boolean;
  1957. begin
  1958. result := (fRange.a > 0);
  1959. end;
  1960. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1961. function TFormatDescriptor.GetglFormat: GLenum;
  1962. begin
  1963. result := fglFormat;
  1964. end;
  1965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1966. function TFormatDescriptor.GetglInternalFormat: GLenum;
  1967. begin
  1968. result := fglInternalFormat;
  1969. end;
  1970. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1971. function TFormatDescriptor.GetglDataFormat: GLenum;
  1972. begin
  1973. result := fglDataFormat;
  1974. end;
  1975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1976. function TFormatDescriptor.GetComponents: Integer;
  1977. var
  1978. i: Integer;
  1979. begin
  1980. result := 0;
  1981. for i := 0 to 3 do
  1982. if (fRange.arr[i] > 0) then
  1983. inc(result);
  1984. end;
  1985. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1986. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  1987. var
  1988. w, h: Integer;
  1989. begin
  1990. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  1991. w := Max(1, aSize.X);
  1992. h := Max(1, aSize.Y);
  1993. result := GetSize(w, h);
  1994. end else
  1995. result := 0;
  1996. end;
  1997. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1998. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  1999. begin
  2000. result := 0;
  2001. if (aWidth <= 0) or (aHeight <= 0) then
  2002. exit;
  2003. result := Ceil(aWidth * aHeight * fPixelSize);
  2004. end;
  2005. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2006. function TFormatDescriptor.CreateMappingData: Pointer;
  2007. begin
  2008. result := nil;
  2009. end;
  2010. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2011. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2012. begin
  2013. //DUMMY
  2014. end;
  2015. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2016. function TFormatDescriptor.IsEmpty: Boolean;
  2017. begin
  2018. result := (fFormat = tfEmpty);
  2019. end;
  2020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2021. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  2022. begin
  2023. result := false;
  2024. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2025. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2026. if (aRedMask <> RedMask) then
  2027. exit;
  2028. if (aGreenMask <> GreenMask) then
  2029. exit;
  2030. if (aBlueMask <> BlueMask) then
  2031. exit;
  2032. if (aAlphaMask <> AlphaMask) then
  2033. exit;
  2034. result := true;
  2035. end;
  2036. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2037. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2038. begin
  2039. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2040. aPixel.Data := fRange;
  2041. aPixel.Range := fRange;
  2042. aPixel.Format := fFormat;
  2043. end;
  2044. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2045. constructor TFormatDescriptor.Create;
  2046. begin
  2047. inherited Create;
  2048. fFormat := tfEmpty;
  2049. fWithAlpha := tfEmpty;
  2050. fWithoutAlpha := tfEmpty;
  2051. fRGBInverted := tfEmpty;
  2052. fUncompressed := tfEmpty;
  2053. fPixelSize := 0.0;
  2054. fIsCompressed := false;
  2055. fglFormat := 0;
  2056. fglInternalFormat := 0;
  2057. fglDataFormat := 0;
  2058. FillChar(fRange, 0, SizeOf(fRange));
  2059. FillChar(fShift, 0, SizeOf(fShift));
  2060. end;
  2061. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2062. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2063. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2064. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2065. begin
  2066. aData^ := aPixel.Data.a;
  2067. inc(aData);
  2068. end;
  2069. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2070. begin
  2071. aPixel.Data.r := 0;
  2072. aPixel.Data.g := 0;
  2073. aPixel.Data.b := 0;
  2074. aPixel.Data.a := aData^;
  2075. inc(aData);
  2076. end;
  2077. constructor TfdAlpha_UB1.Create;
  2078. begin
  2079. inherited Create;
  2080. fPixelSize := 1.0;
  2081. fRange.a := $FF;
  2082. fglFormat := GL_ALPHA;
  2083. fglDataFormat := GL_UNSIGNED_BYTE;
  2084. end;
  2085. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2086. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2088. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2089. begin
  2090. aData^ := LuminanceWeight(aPixel);
  2091. inc(aData);
  2092. end;
  2093. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2094. begin
  2095. aPixel.Data.r := aData^;
  2096. aPixel.Data.g := aData^;
  2097. aPixel.Data.b := aData^;
  2098. aPixel.Data.a := 0;
  2099. inc(aData);
  2100. end;
  2101. constructor TfdLuminance_UB1.Create;
  2102. begin
  2103. inherited Create;
  2104. fPixelSize := 1.0;
  2105. fRange.r := $FF;
  2106. fRange.g := $FF;
  2107. fRange.b := $FF;
  2108. fglFormat := GL_LUMINANCE;
  2109. fglDataFormat := GL_UNSIGNED_BYTE;
  2110. end;
  2111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2112. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2113. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2114. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2115. var
  2116. i: Integer;
  2117. begin
  2118. aData^ := 0;
  2119. for i := 0 to 3 do
  2120. if (fRange.arr[i] > 0) then
  2121. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2122. inc(aData);
  2123. end;
  2124. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2125. var
  2126. i: Integer;
  2127. begin
  2128. for i := 0 to 3 do
  2129. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2130. inc(aData);
  2131. end;
  2132. constructor TfdUniversal_UB1.Create;
  2133. begin
  2134. inherited Create;
  2135. fPixelSize := 1.0;
  2136. end;
  2137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2138. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2139. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2140. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2141. begin
  2142. inherited Map(aPixel, aData, aMapData);
  2143. aData^ := aPixel.Data.a;
  2144. inc(aData);
  2145. end;
  2146. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2147. begin
  2148. inherited Unmap(aData, aPixel, aMapData);
  2149. aPixel.Data.a := aData^;
  2150. inc(aData);
  2151. end;
  2152. constructor TfdLuminanceAlpha_UB2.Create;
  2153. begin
  2154. inherited Create;
  2155. fPixelSize := 2.0;
  2156. fRange.a := $FF;
  2157. fShift.a := 8;
  2158. fglFormat := GL_LUMINANCE_ALPHA;
  2159. fglDataFormat := GL_UNSIGNED_BYTE;
  2160. end;
  2161. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2162. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2163. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2164. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2165. begin
  2166. aData^ := aPixel.Data.r;
  2167. inc(aData);
  2168. aData^ := aPixel.Data.g;
  2169. inc(aData);
  2170. aData^ := aPixel.Data.b;
  2171. inc(aData);
  2172. end;
  2173. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2174. begin
  2175. aPixel.Data.r := aData^;
  2176. inc(aData);
  2177. aPixel.Data.g := aData^;
  2178. inc(aData);
  2179. aPixel.Data.b := aData^;
  2180. inc(aData);
  2181. aPixel.Data.a := 0;
  2182. end;
  2183. constructor TfdRGB_UB3.Create;
  2184. begin
  2185. inherited Create;
  2186. fPixelSize := 3.0;
  2187. fRange.r := $FF;
  2188. fRange.g := $FF;
  2189. fRange.b := $FF;
  2190. fShift.r := 0;
  2191. fShift.g := 8;
  2192. fShift.b := 16;
  2193. fglFormat := GL_RGB;
  2194. fglDataFormat := GL_UNSIGNED_BYTE;
  2195. end;
  2196. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2197. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2198. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2199. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2200. begin
  2201. aData^ := aPixel.Data.b;
  2202. inc(aData);
  2203. aData^ := aPixel.Data.g;
  2204. inc(aData);
  2205. aData^ := aPixel.Data.r;
  2206. inc(aData);
  2207. end;
  2208. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2209. begin
  2210. aPixel.Data.b := aData^;
  2211. inc(aData);
  2212. aPixel.Data.g := aData^;
  2213. inc(aData);
  2214. aPixel.Data.r := aData^;
  2215. inc(aData);
  2216. aPixel.Data.a := 0;
  2217. end;
  2218. constructor TfdBGR_UB3.Create;
  2219. begin
  2220. fPixelSize := 3.0;
  2221. fRange.r := $FF;
  2222. fRange.g := $FF;
  2223. fRange.b := $FF;
  2224. fShift.r := 16;
  2225. fShift.g := 8;
  2226. fShift.b := 0;
  2227. fglFormat := GL_BGR;
  2228. fglDataFormat := GL_UNSIGNED_BYTE;
  2229. end;
  2230. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2231. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2232. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2233. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2234. begin
  2235. inherited Map(aPixel, aData, aMapData);
  2236. aData^ := aPixel.Data.a;
  2237. inc(aData);
  2238. end;
  2239. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2240. begin
  2241. inherited Unmap(aData, aPixel, aMapData);
  2242. aPixel.Data.a := aData^;
  2243. inc(aData);
  2244. end;
  2245. constructor TfdRGBA_UB4.Create;
  2246. begin
  2247. inherited Create;
  2248. fPixelSize := 4.0;
  2249. fRange.a := $FF;
  2250. fShift.a := 24;
  2251. fglFormat := GL_RGBA;
  2252. fglDataFormat := GL_UNSIGNED_BYTE;
  2253. end;
  2254. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2255. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2256. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2257. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2258. begin
  2259. inherited Map(aPixel, aData, aMapData);
  2260. aData^ := aPixel.Data.a;
  2261. inc(aData);
  2262. end;
  2263. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2264. begin
  2265. inherited Unmap(aData, aPixel, aMapData);
  2266. aPixel.Data.a := aData^;
  2267. inc(aData);
  2268. end;
  2269. constructor TfdBGRA_UB4.Create;
  2270. begin
  2271. inherited Create;
  2272. fPixelSize := 4.0;
  2273. fRange.a := $FF;
  2274. fShift.a := 24;
  2275. fglFormat := GL_BGRA;
  2276. fglDataFormat := GL_UNSIGNED_BYTE;
  2277. end;
  2278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2279. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2281. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2282. begin
  2283. PWord(aData)^ := aPixel.Data.a;
  2284. inc(aData, 2);
  2285. end;
  2286. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2287. begin
  2288. aPixel.Data.r := 0;
  2289. aPixel.Data.g := 0;
  2290. aPixel.Data.b := 0;
  2291. aPixel.Data.a := PWord(aData)^;
  2292. inc(aData, 2);
  2293. end;
  2294. constructor TfdAlpha_US1.Create;
  2295. begin
  2296. inherited Create;
  2297. fPixelSize := 2.0;
  2298. fRange.a := $FFFF;
  2299. fglFormat := GL_ALPHA;
  2300. fglDataFormat := GL_UNSIGNED_SHORT;
  2301. end;
  2302. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2303. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2304. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2305. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2306. begin
  2307. PWord(aData)^ := LuminanceWeight(aPixel);
  2308. inc(aData, 2);
  2309. end;
  2310. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2311. begin
  2312. aPixel.Data.r := PWord(aData)^;
  2313. aPixel.Data.g := PWord(aData)^;
  2314. aPixel.Data.b := PWord(aData)^;
  2315. aPixel.Data.a := 0;
  2316. inc(aData, 2);
  2317. end;
  2318. constructor TfdLuminance_US1.Create;
  2319. begin
  2320. inherited Create;
  2321. fPixelSize := 2.0;
  2322. fRange.r := $FFFF;
  2323. fRange.g := $FFFF;
  2324. fRange.b := $FFFF;
  2325. fglFormat := GL_LUMINANCE;
  2326. fglDataFormat := GL_UNSIGNED_SHORT;
  2327. end;
  2328. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2329. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2330. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2331. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2332. var
  2333. i: Integer;
  2334. begin
  2335. PWord(aData)^ := 0;
  2336. for i := 0 to 3 do
  2337. if (fRange.arr[i] > 0) then
  2338. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2339. inc(aData, 2);
  2340. end;
  2341. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2342. var
  2343. i: Integer;
  2344. begin
  2345. for i := 0 to 3 do
  2346. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2347. inc(aData, 2);
  2348. end;
  2349. constructor TfdUniversal_US1.Create;
  2350. begin
  2351. inherited Create;
  2352. fPixelSize := 2.0;
  2353. end;
  2354. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2355. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2356. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2357. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2358. begin
  2359. PWord(aData)^ := DepthWeight(aPixel);
  2360. inc(aData, 2);
  2361. end;
  2362. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2363. begin
  2364. aPixel.Data.r := PWord(aData)^;
  2365. aPixel.Data.g := PWord(aData)^;
  2366. aPixel.Data.b := PWord(aData)^;
  2367. aPixel.Data.a := 0;
  2368. inc(aData, 2);
  2369. end;
  2370. constructor TfdDepth_US1.Create;
  2371. begin
  2372. inherited Create;
  2373. fPixelSize := 2.0;
  2374. fRange.r := $FFFF;
  2375. fRange.g := $FFFF;
  2376. fRange.b := $FFFF;
  2377. fglFormat := GL_DEPTH_COMPONENT;
  2378. fglDataFormat := GL_UNSIGNED_SHORT;
  2379. end;
  2380. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2381. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2382. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2383. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2384. begin
  2385. inherited Map(aPixel, aData, aMapData);
  2386. PWord(aData)^ := aPixel.Data.a;
  2387. inc(aData, 2);
  2388. end;
  2389. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2390. begin
  2391. inherited Unmap(aData, aPixel, aMapData);
  2392. aPixel.Data.a := PWord(aData)^;
  2393. inc(aData, 2);
  2394. end;
  2395. constructor TfdLuminanceAlpha_US2.Create;
  2396. begin
  2397. inherited Create;
  2398. fPixelSize := 4.0;
  2399. fRange.a := $FFFF;
  2400. fShift.a := 16;
  2401. fglFormat := GL_LUMINANCE_ALPHA;
  2402. fglDataFormat := GL_UNSIGNED_SHORT;
  2403. end;
  2404. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2405. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2406. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2407. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2408. begin
  2409. PWord(aData)^ := aPixel.Data.r;
  2410. inc(aData, 2);
  2411. PWord(aData)^ := aPixel.Data.g;
  2412. inc(aData, 2);
  2413. PWord(aData)^ := aPixel.Data.b;
  2414. inc(aData, 2);
  2415. end;
  2416. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2417. begin
  2418. aPixel.Data.r := PWord(aData)^;
  2419. inc(aData, 2);
  2420. aPixel.Data.g := PWord(aData)^;
  2421. inc(aData, 2);
  2422. aPixel.Data.b := PWord(aData)^;
  2423. inc(aData, 2);
  2424. aPixel.Data.a := 0;
  2425. end;
  2426. constructor TfdRGB_US3.Create;
  2427. begin
  2428. inherited Create;
  2429. fPixelSize := 6.0;
  2430. fRange.r := $FFFF;
  2431. fRange.g := $FFFF;
  2432. fRange.b := $FFFF;
  2433. fShift.r := 0;
  2434. fShift.g := 16;
  2435. fShift.b := 32;
  2436. fglFormat := GL_RGB;
  2437. fglDataFormat := GL_UNSIGNED_SHORT;
  2438. end;
  2439. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2440. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2441. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2442. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2443. begin
  2444. PWord(aData)^ := aPixel.Data.b;
  2445. inc(aData, 2);
  2446. PWord(aData)^ := aPixel.Data.g;
  2447. inc(aData, 2);
  2448. PWord(aData)^ := aPixel.Data.r;
  2449. inc(aData, 2);
  2450. end;
  2451. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2452. begin
  2453. aPixel.Data.b := PWord(aData)^;
  2454. inc(aData, 2);
  2455. aPixel.Data.g := PWord(aData)^;
  2456. inc(aData, 2);
  2457. aPixel.Data.r := PWord(aData)^;
  2458. inc(aData, 2);
  2459. aPixel.Data.a := 0;
  2460. end;
  2461. constructor TfdBGR_US3.Create;
  2462. begin
  2463. inherited Create;
  2464. fPixelSize := 6.0;
  2465. fRange.r := $FFFF;
  2466. fRange.g := $FFFF;
  2467. fRange.b := $FFFF;
  2468. fShift.r := 32;
  2469. fShift.g := 16;
  2470. fShift.b := 0;
  2471. fglFormat := GL_BGR;
  2472. fglDataFormat := GL_UNSIGNED_SHORT;
  2473. end;
  2474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2475. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2476. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2477. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2478. begin
  2479. inherited Map(aPixel, aData, aMapData);
  2480. PWord(aData)^ := aPixel.Data.a;
  2481. inc(aData, 2);
  2482. end;
  2483. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2484. begin
  2485. inherited Unmap(aData, aPixel, aMapData);
  2486. aPixel.Data.a := PWord(aData)^;
  2487. inc(aData, 2);
  2488. end;
  2489. constructor TfdRGBA_US4.Create;
  2490. begin
  2491. inherited Create;
  2492. fPixelSize := 8.0;
  2493. fRange.a := $FFFF;
  2494. fShift.a := 48;
  2495. fglFormat := GL_RGBA;
  2496. fglDataFormat := GL_UNSIGNED_SHORT;
  2497. end;
  2498. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2499. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2500. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2501. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2502. begin
  2503. inherited Map(aPixel, aData, aMapData);
  2504. PWord(aData)^ := aPixel.Data.a;
  2505. inc(aData, 2);
  2506. end;
  2507. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2508. begin
  2509. inherited Unmap(aData, aPixel, aMapData);
  2510. aPixel.Data.a := PWord(aData)^;
  2511. inc(aData, 2);
  2512. end;
  2513. constructor TfdBGRA_US4.Create;
  2514. begin
  2515. inherited Create;
  2516. fPixelSize := 8.0;
  2517. fRange.a := $FFFF;
  2518. fShift.a := 48;
  2519. fglFormat := GL_BGRA;
  2520. fglDataFormat := GL_UNSIGNED_SHORT;
  2521. end;
  2522. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2523. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2524. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2525. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2526. var
  2527. i: Integer;
  2528. begin
  2529. PCardinal(aData)^ := 0;
  2530. for i := 0 to 3 do
  2531. if (fRange.arr[i] > 0) then
  2532. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2533. inc(aData, 4);
  2534. end;
  2535. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2536. var
  2537. i: Integer;
  2538. begin
  2539. for i := 0 to 3 do
  2540. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2541. inc(aData, 2);
  2542. end;
  2543. constructor TfdUniversal_UI1.Create;
  2544. begin
  2545. inherited Create;
  2546. fPixelSize := 4.0;
  2547. end;
  2548. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2549. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2550. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2551. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2552. begin
  2553. PCardinal(aData)^ := DepthWeight(aPixel);
  2554. inc(aData, 4);
  2555. end;
  2556. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2557. begin
  2558. aPixel.Data.r := PCardinal(aData)^;
  2559. aPixel.Data.g := PCardinal(aData)^;
  2560. aPixel.Data.b := PCardinal(aData)^;
  2561. aPixel.Data.a := 0;
  2562. inc(aData, 4);
  2563. end;
  2564. constructor TfdDepth_UI1.Create;
  2565. begin
  2566. inherited Create;
  2567. fPixelSize := 4.0;
  2568. fRange.r := $FFFFFFFF;
  2569. fRange.g := $FFFFFFFF;
  2570. fRange.b := $FFFFFFFF;
  2571. fglFormat := GL_DEPTH_COMPONENT;
  2572. fglDataFormat := GL_UNSIGNED_INT;
  2573. end;
  2574. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2575. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2576. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2577. constructor TfdAlpha4.Create;
  2578. begin
  2579. inherited Create;
  2580. fFormat := tfAlpha4;
  2581. fWithAlpha := tfAlpha4;
  2582. fglInternalFormat := GL_ALPHA4;
  2583. end;
  2584. constructor TfdAlpha8.Create;
  2585. begin
  2586. inherited Create;
  2587. fFormat := tfAlpha8;
  2588. fWithAlpha := tfAlpha8;
  2589. fglInternalFormat := GL_ALPHA8;
  2590. end;
  2591. constructor TfdAlpha12.Create;
  2592. begin
  2593. inherited Create;
  2594. fFormat := tfAlpha12;
  2595. fWithAlpha := tfAlpha12;
  2596. fglInternalFormat := GL_ALPHA12;
  2597. end;
  2598. constructor TfdAlpha16.Create;
  2599. begin
  2600. inherited Create;
  2601. fFormat := tfAlpha16;
  2602. fWithAlpha := tfAlpha16;
  2603. fglInternalFormat := GL_ALPHA16;
  2604. end;
  2605. constructor TfdLuminance4.Create;
  2606. begin
  2607. inherited Create;
  2608. fFormat := tfLuminance4;
  2609. fWithAlpha := tfLuminance4Alpha4;
  2610. fWithoutAlpha := tfLuminance4;
  2611. fglInternalFormat := GL_LUMINANCE4;
  2612. end;
  2613. constructor TfdLuminance8.Create;
  2614. begin
  2615. inherited Create;
  2616. fFormat := tfLuminance8;
  2617. fWithAlpha := tfLuminance8Alpha8;
  2618. fWithoutAlpha := tfLuminance8;
  2619. fglInternalFormat := GL_LUMINANCE8;
  2620. end;
  2621. constructor TfdLuminance12.Create;
  2622. begin
  2623. inherited Create;
  2624. fFormat := tfLuminance12;
  2625. fWithAlpha := tfLuminance12Alpha12;
  2626. fWithoutAlpha := tfLuminance12;
  2627. fglInternalFormat := GL_LUMINANCE12;
  2628. end;
  2629. constructor TfdLuminance16.Create;
  2630. begin
  2631. inherited Create;
  2632. fFormat := tfLuminance16;
  2633. fWithAlpha := tfLuminance16Alpha16;
  2634. fWithoutAlpha := tfLuminance16;
  2635. fglInternalFormat := GL_LUMINANCE16;
  2636. end;
  2637. constructor TfdLuminance4Alpha4.Create;
  2638. begin
  2639. inherited Create;
  2640. fFormat := tfLuminance4Alpha4;
  2641. fWithAlpha := tfLuminance4Alpha4;
  2642. fWithoutAlpha := tfLuminance4;
  2643. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2644. end;
  2645. constructor TfdLuminance6Alpha2.Create;
  2646. begin
  2647. inherited Create;
  2648. fFormat := tfLuminance6Alpha2;
  2649. fWithAlpha := tfLuminance6Alpha2;
  2650. fWithoutAlpha := tfLuminance8;
  2651. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2652. end;
  2653. constructor TfdLuminance8Alpha8.Create;
  2654. begin
  2655. inherited Create;
  2656. fFormat := tfLuminance8Alpha8;
  2657. fWithAlpha := tfLuminance8Alpha8;
  2658. fWithoutAlpha := tfLuminance8;
  2659. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2660. end;
  2661. constructor TfdLuminance12Alpha4.Create;
  2662. begin
  2663. inherited Create;
  2664. fFormat := tfLuminance12Alpha4;
  2665. fWithAlpha := tfLuminance12Alpha4;
  2666. fWithoutAlpha := tfLuminance12;
  2667. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2668. end;
  2669. constructor TfdLuminance12Alpha12.Create;
  2670. begin
  2671. inherited Create;
  2672. fFormat := tfLuminance12Alpha12;
  2673. fWithAlpha := tfLuminance12Alpha12;
  2674. fWithoutAlpha := tfLuminance12;
  2675. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2676. end;
  2677. constructor TfdLuminance16Alpha16.Create;
  2678. begin
  2679. inherited Create;
  2680. fFormat := tfLuminance16Alpha16;
  2681. fWithAlpha := tfLuminance16Alpha16;
  2682. fWithoutAlpha := tfLuminance16;
  2683. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2684. end;
  2685. constructor TfdR3G3B2.Create;
  2686. begin
  2687. inherited Create;
  2688. fFormat := tfR3G3B2;
  2689. fWithAlpha := tfRGBA2;
  2690. fWithoutAlpha := tfR3G3B2;
  2691. fRange.r := $7;
  2692. fRange.g := $7;
  2693. fRange.b := $3;
  2694. fShift.r := 0;
  2695. fShift.g := 3;
  2696. fShift.b := 6;
  2697. fglFormat := GL_RGB;
  2698. fglInternalFormat := GL_R3_G3_B2;
  2699. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2700. end;
  2701. constructor TfdRGB4.Create;
  2702. begin
  2703. inherited Create;
  2704. fFormat := tfRGB4;
  2705. fWithAlpha := tfRGBA4;
  2706. fWithoutAlpha := tfRGB4;
  2707. fRGBInverted := tfBGR4;
  2708. fRange.r := $F;
  2709. fRange.g := $F;
  2710. fRange.b := $F;
  2711. fShift.r := 0;
  2712. fShift.g := 4;
  2713. fShift.b := 8;
  2714. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2715. fglInternalFormat := GL_RGB4;
  2716. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2717. end;
  2718. constructor TfdR5G6B5.Create;
  2719. begin
  2720. inherited Create;
  2721. fFormat := tfR5G6B5;
  2722. fWithAlpha := tfRGBA4;
  2723. fWithoutAlpha := tfR5G6B5;
  2724. fRGBInverted := tfB5G6R5;
  2725. fRange.r := $1F;
  2726. fRange.g := $3F;
  2727. fRange.b := $1F;
  2728. fShift.r := 0;
  2729. fShift.g := 5;
  2730. fShift.b := 11;
  2731. fglFormat := GL_RGB;
  2732. fglInternalFormat := GL_RGB565;
  2733. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2734. end;
  2735. constructor TfdRGB5.Create;
  2736. begin
  2737. inherited Create;
  2738. fFormat := tfRGB5;
  2739. fWithAlpha := tfRGB5A1;
  2740. fWithoutAlpha := tfRGB5;
  2741. fRGBInverted := tfBGR5;
  2742. fRange.r := $1F;
  2743. fRange.g := $1F;
  2744. fRange.b := $1F;
  2745. fShift.r := 0;
  2746. fShift.g := 5;
  2747. fShift.b := 10;
  2748. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2749. fglInternalFormat := GL_RGB5;
  2750. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2751. end;
  2752. constructor TfdRGB8.Create;
  2753. begin
  2754. inherited Create;
  2755. fFormat := tfRGB8;
  2756. fWithAlpha := tfRGBA8;
  2757. fWithoutAlpha := tfRGB8;
  2758. fRGBInverted := tfBGR8;
  2759. fglInternalFormat := GL_RGB8;
  2760. end;
  2761. constructor TfdRGB10.Create;
  2762. begin
  2763. inherited Create;
  2764. fFormat := tfRGB10;
  2765. fWithAlpha := tfRGB10A2;
  2766. fWithoutAlpha := tfRGB10;
  2767. fRGBInverted := tfBGR10;
  2768. fRange.r := $3FF;
  2769. fRange.g := $3FF;
  2770. fRange.b := $3FF;
  2771. fShift.r := 0;
  2772. fShift.g := 10;
  2773. fShift.b := 20;
  2774. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2775. fglInternalFormat := GL_RGB10;
  2776. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2777. end;
  2778. constructor TfdRGB12.Create;
  2779. begin
  2780. inherited Create;
  2781. fFormat := tfRGB12;
  2782. fWithAlpha := tfRGBA12;
  2783. fWithoutAlpha := tfRGB12;
  2784. fRGBInverted := tfBGR12;
  2785. fglInternalFormat := GL_RGB12;
  2786. end;
  2787. constructor TfdRGB16.Create;
  2788. begin
  2789. inherited Create;
  2790. fFormat := tfRGB16;
  2791. fWithAlpha := tfRGBA16;
  2792. fWithoutAlpha := tfRGB16;
  2793. fRGBInverted := tfBGR16;
  2794. fglInternalFormat := GL_RGB16;
  2795. end;
  2796. constructor TfdRGBA2.Create;
  2797. begin
  2798. inherited Create;
  2799. fFormat := tfRGBA2;
  2800. fWithAlpha := tfRGBA2;
  2801. fWithoutAlpha := tfR3G3B2;
  2802. fRGBInverted := tfBGRA2;
  2803. fglInternalFormat := GL_RGBA2;
  2804. end;
  2805. constructor TfdRGBA4.Create;
  2806. begin
  2807. inherited Create;
  2808. fFormat := tfRGBA4;
  2809. fWithAlpha := tfRGBA4;
  2810. fWithoutAlpha := tfRGB4;
  2811. fRGBInverted := tfBGRA4;
  2812. fRange.r := $F;
  2813. fRange.g := $F;
  2814. fRange.b := $F;
  2815. fRange.a := $F;
  2816. fShift.r := 0;
  2817. fShift.g := 4;
  2818. fShift.b := 8;
  2819. fShift.a := 12;
  2820. fglFormat := GL_RGBA;
  2821. fglInternalFormat := GL_RGBA4;
  2822. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2823. end;
  2824. constructor TfdRGB5A1.Create;
  2825. begin
  2826. inherited Create;
  2827. fFormat := tfRGB5A1;
  2828. fWithAlpha := tfRGB5A1;
  2829. fWithoutAlpha := tfRGB5;
  2830. fRGBInverted := tfBGR5A1;
  2831. fRange.r := $1F;
  2832. fRange.g := $1F;
  2833. fRange.b := $1F;
  2834. fRange.a := $01;
  2835. fShift.r := 0;
  2836. fShift.g := 5;
  2837. fShift.b := 10;
  2838. fShift.a := 15;
  2839. fglFormat := GL_RGBA;
  2840. fglInternalFormat := GL_RGB5_A1;
  2841. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2842. end;
  2843. constructor TfdRGBA8.Create;
  2844. begin
  2845. inherited Create;
  2846. fFormat := tfRGBA8;
  2847. fWithAlpha := tfRGBA8;
  2848. fWithoutAlpha := tfRGB8;
  2849. fRGBInverted := tfBGRA8;
  2850. fglInternalFormat := GL_RGBA8;
  2851. end;
  2852. constructor TfdRGB10A2.Create;
  2853. begin
  2854. inherited Create;
  2855. fFormat := tfRGB10A2;
  2856. fWithAlpha := tfRGB10A2;
  2857. fWithoutAlpha := tfRGB10;
  2858. fRGBInverted := tfBGR10A2;
  2859. fRange.r := $3FF;
  2860. fRange.g := $3FF;
  2861. fRange.b := $3FF;
  2862. fRange.a := $003;
  2863. fShift.r := 0;
  2864. fShift.g := 10;
  2865. fShift.b := 20;
  2866. fShift.a := 30;
  2867. fglFormat := GL_RGBA;
  2868. fglInternalFormat := GL_RGB10_A2;
  2869. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2870. end;
  2871. constructor TfdRGBA12.Create;
  2872. begin
  2873. inherited Create;
  2874. fFormat := tfRGBA12;
  2875. fWithAlpha := tfRGBA12;
  2876. fWithoutAlpha := tfRGB12;
  2877. fRGBInverted := tfBGRA12;
  2878. fglInternalFormat := GL_RGBA12;
  2879. end;
  2880. constructor TfdRGBA16.Create;
  2881. begin
  2882. inherited Create;
  2883. fFormat := tfRGBA16;
  2884. fWithAlpha := tfRGBA16;
  2885. fWithoutAlpha := tfRGB16;
  2886. fRGBInverted := tfBGRA16;
  2887. fglInternalFormat := GL_RGBA16;
  2888. end;
  2889. constructor TfdBGR4.Create;
  2890. begin
  2891. inherited Create;
  2892. fPixelSize := 2.0;
  2893. fFormat := tfBGR4;
  2894. fWithAlpha := tfBGRA4;
  2895. fWithoutAlpha := tfBGR4;
  2896. fRGBInverted := tfRGB4;
  2897. fRange.r := $F;
  2898. fRange.g := $F;
  2899. fRange.b := $F;
  2900. fRange.a := $0;
  2901. fShift.r := 8;
  2902. fShift.g := 4;
  2903. fShift.b := 0;
  2904. fShift.a := 0;
  2905. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2906. fglInternalFormat := GL_RGB4;
  2907. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2908. end;
  2909. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2910. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2911. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2912. constructor TfdB5G6R5.Create;
  2913. begin
  2914. inherited Create;
  2915. fFormat := tfB5G6R5;
  2916. fWithAlpha := tfBGRA4;
  2917. fWithoutAlpha := tfB5G6R5;
  2918. fRGBInverted := tfR5G6B5;
  2919. fRange.r := $1F;
  2920. fRange.g := $3F;
  2921. fRange.b := $1F;
  2922. fShift.r := 11;
  2923. fShift.g := 5;
  2924. fShift.b := 0;
  2925. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2926. fglInternalFormat := GL_RGB8;
  2927. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2928. end;
  2929. constructor TfdBGR5.Create;
  2930. begin
  2931. inherited Create;
  2932. fPixelSize := 2.0;
  2933. fFormat := tfBGR5;
  2934. fWithAlpha := tfBGR5A1;
  2935. fWithoutAlpha := tfBGR5;
  2936. fRGBInverted := tfRGB5;
  2937. fRange.r := $1F;
  2938. fRange.g := $1F;
  2939. fRange.b := $1F;
  2940. fRange.a := $00;
  2941. fShift.r := 10;
  2942. fShift.g := 5;
  2943. fShift.b := 0;
  2944. fShift.a := 0;
  2945. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2946. fglInternalFormat := GL_RGB5;
  2947. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2948. end;
  2949. constructor TfdBGR8.Create;
  2950. begin
  2951. inherited Create;
  2952. fFormat := tfBGR8;
  2953. fWithAlpha := tfBGRA8;
  2954. fWithoutAlpha := tfBGR8;
  2955. fRGBInverted := tfRGB8;
  2956. fglInternalFormat := GL_RGB8;
  2957. end;
  2958. constructor TfdBGR10.Create;
  2959. begin
  2960. inherited Create;
  2961. fFormat := tfBGR10;
  2962. fWithAlpha := tfBGR10A2;
  2963. fWithoutAlpha := tfBGR10;
  2964. fRGBInverted := tfRGB10;
  2965. fRange.r := $3FF;
  2966. fRange.g := $3FF;
  2967. fRange.b := $3FF;
  2968. fRange.a := $000;
  2969. fShift.r := 20;
  2970. fShift.g := 10;
  2971. fShift.b := 0;
  2972. fShift.a := 0;
  2973. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2974. fglInternalFormat := GL_RGB10;
  2975. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2976. end;
  2977. constructor TfdBGR12.Create;
  2978. begin
  2979. inherited Create;
  2980. fFormat := tfBGR12;
  2981. fWithAlpha := tfBGRA12;
  2982. fWithoutAlpha := tfBGR12;
  2983. fRGBInverted := tfRGB12;
  2984. fglInternalFormat := GL_RGB12;
  2985. end;
  2986. constructor TfdBGR16.Create;
  2987. begin
  2988. inherited Create;
  2989. fFormat := tfBGR16;
  2990. fWithAlpha := tfBGRA16;
  2991. fWithoutAlpha := tfBGR16;
  2992. fRGBInverted := tfRGB16;
  2993. fglInternalFormat := GL_RGB16;
  2994. end;
  2995. constructor TfdBGRA2.Create;
  2996. begin
  2997. inherited Create;
  2998. fFormat := tfBGRA2;
  2999. fWithAlpha := tfBGRA4;
  3000. fWithoutAlpha := tfBGR4;
  3001. fRGBInverted := tfRGBA2;
  3002. fglInternalFormat := GL_RGBA2;
  3003. end;
  3004. constructor TfdBGRA4.Create;
  3005. begin
  3006. inherited Create;
  3007. fFormat := tfBGRA4;
  3008. fWithAlpha := tfBGRA4;
  3009. fWithoutAlpha := tfBGR4;
  3010. fRGBInverted := tfRGBA4;
  3011. fRange.r := $F;
  3012. fRange.g := $F;
  3013. fRange.b := $F;
  3014. fRange.a := $F;
  3015. fShift.r := 8;
  3016. fShift.g := 4;
  3017. fShift.b := 0;
  3018. fShift.a := 12;
  3019. fglFormat := GL_BGRA;
  3020. fglInternalFormat := GL_RGBA4;
  3021. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3022. end;
  3023. constructor TfdBGR5A1.Create;
  3024. begin
  3025. inherited Create;
  3026. fFormat := tfBGR5A1;
  3027. fWithAlpha := tfBGR5A1;
  3028. fWithoutAlpha := tfBGR5;
  3029. fRGBInverted := tfRGB5A1;
  3030. fRange.r := $1F;
  3031. fRange.g := $1F;
  3032. fRange.b := $1F;
  3033. fRange.a := $01;
  3034. fShift.r := 10;
  3035. fShift.g := 5;
  3036. fShift.b := 0;
  3037. fShift.a := 15;
  3038. fglFormat := GL_BGRA;
  3039. fglInternalFormat := GL_RGB5_A1;
  3040. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3041. end;
  3042. constructor TfdBGRA8.Create;
  3043. begin
  3044. inherited Create;
  3045. fFormat := tfBGRA8;
  3046. fWithAlpha := tfBGRA8;
  3047. fWithoutAlpha := tfBGR8;
  3048. fRGBInverted := tfRGBA8;
  3049. fglInternalFormat := GL_RGBA8;
  3050. end;
  3051. constructor TfdBGR10A2.Create;
  3052. begin
  3053. inherited Create;
  3054. fFormat := tfBGR10A2;
  3055. fWithAlpha := tfBGR10A2;
  3056. fWithoutAlpha := tfBGR10;
  3057. fRGBInverted := tfRGB10A2;
  3058. fRange.r := $3FF;
  3059. fRange.g := $3FF;
  3060. fRange.b := $3FF;
  3061. fRange.a := $003;
  3062. fShift.r := 20;
  3063. fShift.g := 10;
  3064. fShift.b := 0;
  3065. fShift.a := 30;
  3066. fglFormat := GL_BGRA;
  3067. fglInternalFormat := GL_RGB10_A2;
  3068. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3069. end;
  3070. constructor TfdBGRA12.Create;
  3071. begin
  3072. inherited Create;
  3073. fFormat := tfBGRA12;
  3074. fWithAlpha := tfBGRA12;
  3075. fWithoutAlpha := tfBGR12;
  3076. fRGBInverted := tfRGBA12;
  3077. fglInternalFormat := GL_RGBA12;
  3078. end;
  3079. constructor TfdBGRA16.Create;
  3080. begin
  3081. inherited Create;
  3082. fFormat := tfBGRA16;
  3083. fWithAlpha := tfBGRA16;
  3084. fWithoutAlpha := tfBGR16;
  3085. fRGBInverted := tfRGBA16;
  3086. fglInternalFormat := GL_RGBA16;
  3087. end;
  3088. constructor TfdDepth16.Create;
  3089. begin
  3090. inherited Create;
  3091. fFormat := tfDepth16;
  3092. fWithAlpha := tfEmpty;
  3093. fWithoutAlpha := tfDepth16;
  3094. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3095. end;
  3096. constructor TfdDepth24.Create;
  3097. begin
  3098. inherited Create;
  3099. fFormat := tfDepth24;
  3100. fWithAlpha := tfEmpty;
  3101. fWithoutAlpha := tfDepth24;
  3102. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3103. end;
  3104. constructor TfdDepth32.Create;
  3105. begin
  3106. inherited Create;
  3107. fFormat := tfDepth32;
  3108. fWithAlpha := tfEmpty;
  3109. fWithoutAlpha := tfDepth32;
  3110. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3111. end;
  3112. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3113. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3114. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3115. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3116. begin
  3117. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3118. end;
  3119. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3120. begin
  3121. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3122. end;
  3123. constructor TfdS3tcDtx1RGBA.Create;
  3124. begin
  3125. inherited Create;
  3126. fFormat := tfS3tcDtx1RGBA;
  3127. fWithAlpha := tfS3tcDtx1RGBA;
  3128. fUncompressed := tfRGB5A1;
  3129. fPixelSize := 0.5;
  3130. fIsCompressed := true;
  3131. fglFormat := GL_COMPRESSED_RGBA;
  3132. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3133. fglDataFormat := GL_UNSIGNED_BYTE;
  3134. end;
  3135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3136. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3138. procedure TfdS3tcDtx3RGBA.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 TfdS3tcDtx3RGBA.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 TfdS3tcDtx3RGBA.Create;
  3147. begin
  3148. inherited Create;
  3149. fFormat := tfS3tcDtx3RGBA;
  3150. fWithAlpha := tfS3tcDtx3RGBA;
  3151. fUncompressed := tfRGBA8;
  3152. fPixelSize := 1.0;
  3153. fIsCompressed := true;
  3154. fglFormat := GL_COMPRESSED_RGBA;
  3155. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3156. fglDataFormat := GL_UNSIGNED_BYTE;
  3157. end;
  3158. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3159. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3160. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3161. procedure TfdS3tcDtx5RGBA.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 TfdS3tcDtx5RGBA.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 TfdS3tcDtx5RGBA.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_DXT5_EXT;
  3179. fglDataFormat := GL_UNSIGNED_BYTE;
  3180. end;
  3181. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3182. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3183. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3184. class procedure TFormatDescriptor.Init;
  3185. begin
  3186. if not Assigned(FormatDescriptorCS) then
  3187. FormatDescriptorCS := TCriticalSection.Create;
  3188. end;
  3189. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3190. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3191. begin
  3192. FormatDescriptorCS.Enter;
  3193. try
  3194. result := FormatDescriptors[aFormat];
  3195. if not Assigned(result) then begin
  3196. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3197. FormatDescriptors[aFormat] := result;
  3198. end;
  3199. finally
  3200. FormatDescriptorCS.Leave;
  3201. end;
  3202. end;
  3203. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3204. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3205. begin
  3206. result := Get(Get(aFormat).WithAlpha);
  3207. end;
  3208. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3209. class procedure TFormatDescriptor.Clear;
  3210. var
  3211. f: TglBitmapFormat;
  3212. begin
  3213. FormatDescriptorCS.Enter;
  3214. try
  3215. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3216. FreeAndNil(FormatDescriptors[f]);
  3217. finally
  3218. FormatDescriptorCS.Leave;
  3219. end;
  3220. end;
  3221. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3222. class procedure TFormatDescriptor.Finalize;
  3223. begin
  3224. Clear;
  3225. FreeAndNil(FormatDescriptorCS);
  3226. end;
  3227. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3228. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3229. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3230. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3231. begin
  3232. Update(aValue, fRange.r, fShift.r);
  3233. end;
  3234. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3235. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3236. begin
  3237. Update(aValue, fRange.g, fShift.g);
  3238. end;
  3239. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3240. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3241. begin
  3242. Update(aValue, fRange.b, fShift.b);
  3243. end;
  3244. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3245. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3246. begin
  3247. Update(aValue, fRange.a, fShift.a);
  3248. end;
  3249. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3250. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3251. aShift: Byte);
  3252. begin
  3253. aShift := 0;
  3254. aRange := 0;
  3255. if (aMask = 0) then
  3256. exit;
  3257. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3258. inc(aShift);
  3259. aMask := aMask shr 1;
  3260. end;
  3261. aRange := 1;
  3262. while (aMask > 0) do begin
  3263. aRange := aRange shl 1;
  3264. aMask := aMask shr 1;
  3265. end;
  3266. dec(aRange);
  3267. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3268. end;
  3269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3270. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3271. var
  3272. data: QWord;
  3273. s: Integer;
  3274. begin
  3275. data :=
  3276. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3277. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3278. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3279. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3280. s := Round(fPixelSize);
  3281. case s of
  3282. 1: aData^ := data;
  3283. 2: PWord(aData)^ := data;
  3284. 4: PCardinal(aData)^ := data;
  3285. 8: PQWord(aData)^ := data;
  3286. else
  3287. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3288. end;
  3289. inc(aData, s);
  3290. end;
  3291. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3292. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3293. var
  3294. data: QWord;
  3295. s, i: Integer;
  3296. begin
  3297. s := Round(fPixelSize);
  3298. case s of
  3299. 1: data := aData^;
  3300. 2: data := PWord(aData)^;
  3301. 4: data := PCardinal(aData)^;
  3302. 8: data := PQWord(aData)^;
  3303. else
  3304. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3305. end;
  3306. for i := 0 to 3 do
  3307. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3308. inc(aData, s);
  3309. end;
  3310. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3311. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3312. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3313. procedure TbmpColorTableFormat.CreateColorTable;
  3314. var
  3315. i: Integer;
  3316. begin
  3317. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3318. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3319. if (Format = tfLuminance4) then
  3320. SetLength(fColorTable, 16)
  3321. else
  3322. SetLength(fColorTable, 256);
  3323. case Format of
  3324. tfLuminance4: begin
  3325. for i := 0 to High(fColorTable) do begin
  3326. fColorTable[i].r := 16 * i;
  3327. fColorTable[i].g := 16 * i;
  3328. fColorTable[i].b := 16 * i;
  3329. fColorTable[i].a := 0;
  3330. end;
  3331. end;
  3332. tfLuminance8: begin
  3333. for i := 0 to High(fColorTable) do begin
  3334. fColorTable[i].r := i;
  3335. fColorTable[i].g := i;
  3336. fColorTable[i].b := i;
  3337. fColorTable[i].a := 0;
  3338. end;
  3339. end;
  3340. tfR3G3B2: begin
  3341. for i := 0 to High(fColorTable) do begin
  3342. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3343. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3344. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3345. fColorTable[i].a := 0;
  3346. end;
  3347. end;
  3348. end;
  3349. end;
  3350. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3351. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3352. var
  3353. d: Byte;
  3354. begin
  3355. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3356. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3357. case Format of
  3358. tfLuminance4: begin
  3359. if (aMapData = nil) then
  3360. aData^ := 0;
  3361. d := LuminanceWeight(aPixel) and Range.r;
  3362. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3363. inc(PByte(aMapData), 4);
  3364. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3365. inc(aData);
  3366. aMapData := nil;
  3367. end;
  3368. end;
  3369. tfLuminance8: begin
  3370. aData^ := LuminanceWeight(aPixel) and Range.r;
  3371. inc(aData);
  3372. end;
  3373. tfR3G3B2: begin
  3374. aData^ := Round(
  3375. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3376. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3377. ((aPixel.Data.b and Range.b) shl Shift.b));
  3378. inc(aData);
  3379. end;
  3380. end;
  3381. end;
  3382. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3383. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3384. var
  3385. idx: QWord;
  3386. s: Integer;
  3387. bits: Byte;
  3388. f: Single;
  3389. begin
  3390. s := Trunc(fPixelSize);
  3391. f := fPixelSize - s;
  3392. bits := Round(8 * f);
  3393. case s of
  3394. 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
  3395. 1: idx := aData^;
  3396. 2: idx := PWord(aData)^;
  3397. 4: idx := PCardinal(aData)^;
  3398. 8: idx := PQWord(aData)^;
  3399. else
  3400. raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3401. end;
  3402. if (idx >= Length(fColorTable)) then
  3403. raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
  3404. with fColorTable[idx] do begin
  3405. aPixel.Data.r := r;
  3406. aPixel.Data.g := g;
  3407. aPixel.Data.b := b;
  3408. aPixel.Data.a := a;
  3409. end;
  3410. inc(PByte(aMapData), bits);
  3411. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3412. inc(aData, 1);
  3413. dec(PByte(aMapData), 8);
  3414. end;
  3415. inc(aData, s);
  3416. end;
  3417. destructor TbmpColorTableFormat.Destroy;
  3418. begin
  3419. SetLength(fColorTable, 0);
  3420. inherited Destroy;
  3421. end;
  3422. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3423. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3424. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3425. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3426. var
  3427. i: Integer;
  3428. begin
  3429. for i := 0 to 3 do begin
  3430. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3431. if (aSourceFD.Range.arr[i] > 0) then
  3432. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3433. else
  3434. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3435. end;
  3436. end;
  3437. end;
  3438. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3439. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3440. begin
  3441. with aFuncRec do begin
  3442. if (Source.Range.r > 0) then
  3443. Dest.Data.r := Source.Data.r;
  3444. if (Source.Range.g > 0) then
  3445. Dest.Data.g := Source.Data.g;
  3446. if (Source.Range.b > 0) then
  3447. Dest.Data.b := Source.Data.b;
  3448. if (Source.Range.a > 0) then
  3449. Dest.Data.a := Source.Data.a;
  3450. end;
  3451. end;
  3452. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3453. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3454. var
  3455. i: Integer;
  3456. begin
  3457. with aFuncRec do begin
  3458. for i := 0 to 3 do
  3459. if (Source.Range.arr[i] > 0) then
  3460. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3461. end;
  3462. end;
  3463. type
  3464. TShiftData = packed record
  3465. case Integer of
  3466. 0: (r, g, b, a: SmallInt);
  3467. 1: (arr: array[0..3] of SmallInt);
  3468. end;
  3469. PShiftData = ^TShiftData;
  3470. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3471. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3472. var
  3473. i: Integer;
  3474. begin
  3475. with aFuncRec do
  3476. for i := 0 to 3 do
  3477. if (Source.Range.arr[i] > 0) then
  3478. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3479. end;
  3480. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3481. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3482. begin
  3483. with aFuncRec do begin
  3484. Dest.Data := Source.Data;
  3485. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3486. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3487. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3488. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3489. end;
  3490. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3491. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3492. end;
  3493. end;
  3494. end;
  3495. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3496. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3497. var
  3498. i: Integer;
  3499. begin
  3500. with aFuncRec do begin
  3501. for i := 0 to 3 do
  3502. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3503. end;
  3504. end;
  3505. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3506. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3507. var
  3508. Temp: Single;
  3509. begin
  3510. with FuncRec do begin
  3511. if (FuncRec.Args = nil) then begin //source has no alpha
  3512. Temp :=
  3513. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3514. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3515. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3516. Dest.Data.a := Round(Dest.Range.a * Temp);
  3517. end else
  3518. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3519. end;
  3520. end;
  3521. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3522. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3523. type
  3524. PglBitmapPixelData = ^TglBitmapPixelData;
  3525. begin
  3526. with FuncRec do begin
  3527. Dest.Data.r := Source.Data.r;
  3528. Dest.Data.g := Source.Data.g;
  3529. Dest.Data.b := Source.Data.b;
  3530. with PglBitmapPixelData(Args)^ do
  3531. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3532. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3533. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3534. Dest.Data.a := 0
  3535. else
  3536. Dest.Data.a := Dest.Range.a;
  3537. end;
  3538. end;
  3539. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3540. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3541. begin
  3542. with FuncRec do begin
  3543. Dest.Data.r := Source.Data.r;
  3544. Dest.Data.g := Source.Data.g;
  3545. Dest.Data.b := Source.Data.b;
  3546. Dest.Data.a := PCardinal(Args)^;
  3547. end;
  3548. end;
  3549. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3550. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3551. type
  3552. PRGBPix = ^TRGBPix;
  3553. TRGBPix = array [0..2] of byte;
  3554. var
  3555. Temp: Byte;
  3556. begin
  3557. while aWidth > 0 do begin
  3558. Temp := PRGBPix(aData)^[0];
  3559. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3560. PRGBPix(aData)^[2] := Temp;
  3561. if aHasAlpha then
  3562. Inc(aData, 4)
  3563. else
  3564. Inc(aData, 3);
  3565. dec(aWidth);
  3566. end;
  3567. end;
  3568. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3569. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3570. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3571. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  3572. begin
  3573. result := TFormatDescriptor.Get(Format);
  3574. end;
  3575. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3576. function TglBitmap.GetWidth: Integer;
  3577. begin
  3578. if (ffX in fDimension.Fields) then
  3579. result := fDimension.X
  3580. else
  3581. result := -1;
  3582. end;
  3583. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3584. function TglBitmap.GetHeight: Integer;
  3585. begin
  3586. if (ffY in fDimension.Fields) then
  3587. result := fDimension.Y
  3588. else
  3589. result := -1;
  3590. end;
  3591. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3592. function TglBitmap.GetFileWidth: Integer;
  3593. begin
  3594. result := Max(1, Width);
  3595. end;
  3596. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3597. function TglBitmap.GetFileHeight: Integer;
  3598. begin
  3599. result := Max(1, Height);
  3600. end;
  3601. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3602. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3603. begin
  3604. if fCustomData = aValue then
  3605. exit;
  3606. fCustomData := aValue;
  3607. end;
  3608. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3609. procedure TglBitmap.SetCustomName(const aValue: String);
  3610. begin
  3611. if fCustomName = aValue then
  3612. exit;
  3613. fCustomName := aValue;
  3614. end;
  3615. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3616. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3617. begin
  3618. if fCustomNameW = aValue then
  3619. exit;
  3620. fCustomNameW := aValue;
  3621. end;
  3622. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3623. procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
  3624. begin
  3625. if fFreeDataOnDestroy = aValue then
  3626. exit;
  3627. fFreeDataOnDestroy := aValue;
  3628. end;
  3629. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3630. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3631. begin
  3632. if fDeleteTextureOnFree = aValue then
  3633. exit;
  3634. fDeleteTextureOnFree := aValue;
  3635. end;
  3636. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3637. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3638. begin
  3639. if fFormat = aValue then
  3640. exit;
  3641. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3642. raise EglBitmapUnsupportedFormat.Create(Format);
  3643. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  3644. end;
  3645. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3646. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3647. begin
  3648. if fFreeDataAfterGenTexture = aValue then
  3649. exit;
  3650. fFreeDataAfterGenTexture := aValue;
  3651. end;
  3652. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3653. procedure TglBitmap.SetID(const aValue: Cardinal);
  3654. begin
  3655. if fID = aValue then
  3656. exit;
  3657. fID := aValue;
  3658. end;
  3659. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3660. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3661. begin
  3662. if fMipMap = aValue then
  3663. exit;
  3664. fMipMap := aValue;
  3665. end;
  3666. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3667. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3668. begin
  3669. if fTarget = aValue then
  3670. exit;
  3671. fTarget := aValue;
  3672. end;
  3673. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3674. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3675. var
  3676. MaxAnisotropic: Integer;
  3677. begin
  3678. fAnisotropic := aValue;
  3679. if (ID > 0) then begin
  3680. if GL_EXT_texture_filter_anisotropic then begin
  3681. if fAnisotropic > 0 then begin
  3682. Bind(false);
  3683. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3684. if aValue > MaxAnisotropic then
  3685. fAnisotropic := MaxAnisotropic;
  3686. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3687. end;
  3688. end else begin
  3689. fAnisotropic := 0;
  3690. end;
  3691. end;
  3692. end;
  3693. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3694. procedure TglBitmap.CreateID;
  3695. begin
  3696. if (ID <> 0) then
  3697. glDeleteTextures(1, @fID);
  3698. glGenTextures(1, @fID);
  3699. Bind(false);
  3700. end;
  3701. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3702. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3703. begin
  3704. // Set Up Parameters
  3705. SetWrap(fWrapS, fWrapT, fWrapR);
  3706. SetFilter(fFilterMin, fFilterMag);
  3707. SetAnisotropic(fAnisotropic);
  3708. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3709. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  3710. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3711. // Mip Maps Generation Mode
  3712. aBuildWithGlu := false;
  3713. if (MipMap = mmMipmap) then begin
  3714. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3715. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3716. else
  3717. aBuildWithGlu := true;
  3718. end else if (MipMap = mmMipmapGlu) then
  3719. aBuildWithGlu := true;
  3720. end;
  3721. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3722. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  3723. const aWidth: Integer; const aHeight: Integer);
  3724. var
  3725. s: Single;
  3726. begin
  3727. if (Data <> aData) then begin
  3728. if (Assigned(Data)) then
  3729. FreeMem(Data);
  3730. fData := aData;
  3731. end;
  3732. if not Assigned(fData) then begin
  3733. fPixelSize := 0;
  3734. fRowSize := 0;
  3735. end else begin
  3736. FillChar(fDimension, SizeOf(fDimension), 0);
  3737. if aWidth <> -1 then begin
  3738. fDimension.Fields := fDimension.Fields + [ffX];
  3739. fDimension.X := aWidth;
  3740. end;
  3741. if aHeight <> -1 then begin
  3742. fDimension.Fields := fDimension.Fields + [ffY];
  3743. fDimension.Y := aHeight;
  3744. end;
  3745. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3746. fFormat := aFormat;
  3747. fPixelSize := Ceil(s);
  3748. fRowSize := Ceil(s * aWidth);
  3749. end;
  3750. end;
  3751. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3752. function TglBitmap.FlipHorz: Boolean;
  3753. begin
  3754. result := false;
  3755. end;
  3756. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3757. function TglBitmap.FlipVert: Boolean;
  3758. begin
  3759. result := false;
  3760. end;
  3761. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3762. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3763. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3764. procedure TglBitmap.AfterConstruction;
  3765. begin
  3766. inherited AfterConstruction;
  3767. fID := 0;
  3768. fTarget := 0;
  3769. fIsResident := false;
  3770. fMipMap := glBitmapDefaultMipmap;
  3771. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3772. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3773. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3774. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3775. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3776. end;
  3777. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3778. procedure TglBitmap.BeforeDestruction;
  3779. var
  3780. NewData: PByte;
  3781. begin
  3782. if fFreeDataOnDestroy then begin
  3783. NewData := nil;
  3784. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  3785. end;
  3786. if (fID > 0) and fDeleteTextureOnFree then
  3787. glDeleteTextures(1, @fID);
  3788. inherited BeforeDestruction;
  3789. end;
  3790. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3791. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  3792. var
  3793. TempPos: Integer;
  3794. begin
  3795. if not Assigned(aResType) then begin
  3796. TempPos := Pos('.', aResource);
  3797. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3798. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3799. end;
  3800. end;
  3801. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3802. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3803. var
  3804. fs: TFileStream;
  3805. begin
  3806. if not FileExists(aFilename) then
  3807. raise EglBitmap.Create('file does not exist: ' + aFilename);
  3808. fFilename := aFilename;
  3809. fs := TFileStream.Create(fFilename, fmOpenRead);
  3810. try
  3811. fs.Position := 0;
  3812. LoadFromStream(fs);
  3813. finally
  3814. fs.Free;
  3815. end;
  3816. end;
  3817. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3818. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3819. begin
  3820. {$IFDEF GLB_SUPPORT_PNG_READ}
  3821. if not LoadPNG(aStream) then
  3822. {$ENDIF}
  3823. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3824. if not LoadJPEG(aStream) then
  3825. {$ENDIF}
  3826. if not LoadDDS(aStream) then
  3827. if not LoadTGA(aStream) then
  3828. if not LoadBMP(aStream) then
  3829. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3830. end;
  3831. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3832. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3833. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3834. var
  3835. tmpData: PByte;
  3836. size: Integer;
  3837. begin
  3838. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3839. GetMem(tmpData, size);
  3840. try
  3841. FillChar(tmpData^, size, #$FF);
  3842. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  3843. except
  3844. if Assigned(tmpData) then
  3845. FreeMem(tmpData);
  3846. raise;
  3847. end;
  3848. AddFunc(Self, aFunc, false, aFormat, aArgs);
  3849. end;
  3850. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3851. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  3852. var
  3853. rs: TResourceStream;
  3854. begin
  3855. PrepareResType(aResource, aResType);
  3856. rs := TResourceStream.Create(aInstance, aResource, aResType);
  3857. try
  3858. LoadFromStream(rs);
  3859. finally
  3860. rs.Free;
  3861. end;
  3862. end;
  3863. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3864. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3865. var
  3866. rs: TResourceStream;
  3867. begin
  3868. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  3869. try
  3870. LoadFromStream(rs);
  3871. finally
  3872. rs.Free;
  3873. end;
  3874. end;
  3875. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3876. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3877. var
  3878. fs: TFileStream;
  3879. begin
  3880. fs := TFileStream.Create(aFileName, fmCreate);
  3881. try
  3882. fs.Position := 0;
  3883. SaveToStream(fs, aFileType);
  3884. finally
  3885. fs.Free;
  3886. end;
  3887. end;
  3888. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3889. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3890. begin
  3891. case aFileType of
  3892. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3893. ftPNG: SavePNG(aStream);
  3894. {$ENDIF}
  3895. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3896. ftJPEG: SaveJPEG(aStream);
  3897. {$ENDIF}
  3898. ftDDS: SaveDDS(aStream);
  3899. ftTGA: SaveTGA(aStream);
  3900. ftBMP: SaveBMP(aStream);
  3901. end;
  3902. end;
  3903. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3904. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3905. begin
  3906. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3907. end;
  3908. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3909. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3910. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3911. var
  3912. DestData, TmpData, SourceData: pByte;
  3913. TempHeight, TempWidth: Integer;
  3914. SourceFD, DestFD: TFormatDescriptor;
  3915. SourceMD, DestMD: Pointer;
  3916. FuncRec: TglBitmapFunctionRec;
  3917. begin
  3918. Assert(Assigned(Data));
  3919. Assert(Assigned(aSource));
  3920. Assert(Assigned(aSource.Data));
  3921. result := false;
  3922. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3923. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3924. DestFD := TFormatDescriptor.Get(aFormat);
  3925. if (SourceFD.IsCompressed) then
  3926. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  3927. if (DestFD.IsCompressed) then
  3928. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  3929. // inkompatible Formats so CreateTemp
  3930. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3931. aCreateTemp := true;
  3932. // Values
  3933. TempHeight := Max(1, aSource.Height);
  3934. TempWidth := Max(1, aSource.Width);
  3935. FuncRec.Sender := Self;
  3936. FuncRec.Args := aArgs;
  3937. TmpData := nil;
  3938. if aCreateTemp then begin
  3939. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  3940. DestData := TmpData;
  3941. end else
  3942. DestData := Data;
  3943. try
  3944. SourceFD.PreparePixel(FuncRec.Source);
  3945. DestFD.PreparePixel (FuncRec.Dest);
  3946. SourceMD := SourceFD.CreateMappingData;
  3947. DestMD := DestFD.CreateMappingData;
  3948. FuncRec.Size := aSource.Dimension;
  3949. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3950. try
  3951. SourceData := aSource.Data;
  3952. FuncRec.Position.Y := 0;
  3953. while FuncRec.Position.Y < TempHeight do begin
  3954. FuncRec.Position.X := 0;
  3955. while FuncRec.Position.X < TempWidth do begin
  3956. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3957. aFunc(FuncRec);
  3958. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3959. inc(FuncRec.Position.X);
  3960. end;
  3961. inc(FuncRec.Position.Y);
  3962. end;
  3963. // Updating Image or InternalFormat
  3964. if aCreateTemp then
  3965. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  3966. else if (aFormat <> fFormat) then
  3967. Format := aFormat;
  3968. result := true;
  3969. finally
  3970. SourceFD.FreeMappingData(SourceMD);
  3971. DestFD.FreeMappingData(DestMD);
  3972. end;
  3973. except
  3974. if aCreateTemp and Assigned(TmpData) then
  3975. FreeMem(TmpData);
  3976. raise;
  3977. end;
  3978. end;
  3979. end;
  3980. {$IFDEF GLB_SDL}
  3981. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3982. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  3983. var
  3984. Row, RowSize: Integer;
  3985. SourceData, TmpData: PByte;
  3986. TempDepth: Integer;
  3987. FormatDesc: TFormatDescriptor;
  3988. function GetRowPointer(Row: Integer): pByte;
  3989. begin
  3990. result := aSurface.pixels;
  3991. Inc(result, Row * RowSize);
  3992. end;
  3993. begin
  3994. result := false;
  3995. FormatDesc := TFormatDescriptor.Get(Format);
  3996. if FormatDesc.IsCompressed then
  3997. raise EglBitmapUnsupportedFormat.Create(Format);
  3998. if Assigned(Data) then begin
  3999. case Trunc(FormatDesc.PixelSize) of
  4000. 1: TempDepth := 8;
  4001. 2: TempDepth := 16;
  4002. 3: TempDepth := 24;
  4003. 4: TempDepth := 32;
  4004. else
  4005. raise EglBitmapUnsupportedFormat.Create(Format);
  4006. end;
  4007. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4008. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4009. SourceData := Data;
  4010. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4011. for Row := 0 to FileHeight-1 do begin
  4012. TmpData := GetRowPointer(Row);
  4013. if Assigned(TmpData) then begin
  4014. Move(SourceData^, TmpData^, RowSize);
  4015. inc(SourceData, RowSize);
  4016. end;
  4017. end;
  4018. result := true;
  4019. end;
  4020. end;
  4021. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4022. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4023. var
  4024. pSource, pData, pTempData: PByte;
  4025. Row, RowSize, TempWidth, TempHeight: Integer;
  4026. IntFormat: TglBitmapFormat;
  4027. FormatDesc: TFormatDescriptor;
  4028. function GetRowPointer(Row: Integer): pByte;
  4029. begin
  4030. result := aSurface^.pixels;
  4031. Inc(result, Row * RowSize);
  4032. end;
  4033. begin
  4034. result := false;
  4035. if (Assigned(aSurface)) then begin
  4036. with aSurface^.format^ do begin
  4037. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  4038. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4039. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  4040. break;
  4041. end;
  4042. if (IntFormat = tfEmpty) then
  4043. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  4044. end;
  4045. TempWidth := aSurface^.w;
  4046. TempHeight := aSurface^.h;
  4047. RowSize := FormatDesc.GetSize(TempWidth, 1);
  4048. GetMem(pData, TempHeight * RowSize);
  4049. try
  4050. pTempData := pData;
  4051. for Row := 0 to TempHeight -1 do begin
  4052. pSource := GetRowPointer(Row);
  4053. if (Assigned(pSource)) then begin
  4054. Move(pSource^, pTempData^, RowSize);
  4055. Inc(pTempData, RowSize);
  4056. end;
  4057. end;
  4058. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4059. result := true;
  4060. except
  4061. if Assigned(pData) then
  4062. FreeMem(pData);
  4063. raise;
  4064. end;
  4065. end;
  4066. end;
  4067. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4068. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4069. var
  4070. Row, Col, AlphaInterleave: Integer;
  4071. pSource, pDest: PByte;
  4072. function GetRowPointer(Row: Integer): pByte;
  4073. begin
  4074. result := aSurface.pixels;
  4075. Inc(result, Row * Width);
  4076. end;
  4077. begin
  4078. result := false;
  4079. if Assigned(Data) then begin
  4080. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  4081. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4082. AlphaInterleave := 0;
  4083. case Format of
  4084. tfLuminance8Alpha8:
  4085. AlphaInterleave := 1;
  4086. tfBGRA8, tfRGBA8:
  4087. AlphaInterleave := 3;
  4088. end;
  4089. pSource := Data;
  4090. for Row := 0 to Height -1 do begin
  4091. pDest := GetRowPointer(Row);
  4092. if Assigned(pDest) then begin
  4093. for Col := 0 to Width -1 do begin
  4094. Inc(pSource, AlphaInterleave);
  4095. pDest^ := pSource^;
  4096. Inc(pDest);
  4097. Inc(pSource);
  4098. end;
  4099. end;
  4100. end;
  4101. result := true;
  4102. end;
  4103. end;
  4104. end;
  4105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4106. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4107. var
  4108. bmp: TglBitmap2D;
  4109. begin
  4110. bmp := TglBitmap2D.Create;
  4111. try
  4112. bmp.AssignFromSurface(aSurface);
  4113. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4114. finally
  4115. bmp.Free;
  4116. end;
  4117. end;
  4118. {$ENDIF}
  4119. {$IFDEF GLB_DELPHI}
  4120. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4121. function CreateGrayPalette: HPALETTE;
  4122. var
  4123. Idx: Integer;
  4124. Pal: PLogPalette;
  4125. begin
  4126. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4127. Pal.palVersion := $300;
  4128. Pal.palNumEntries := 256;
  4129. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4130. Pal.palPalEntry[Idx].peRed := Idx;
  4131. Pal.palPalEntry[Idx].peGreen := Idx;
  4132. Pal.palPalEntry[Idx].peBlue := Idx;
  4133. Pal.palPalEntry[Idx].peFlags := 0;
  4134. end;
  4135. Result := CreatePalette(Pal^);
  4136. FreeMem(Pal);
  4137. end;
  4138. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4139. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4140. var
  4141. Row: Integer;
  4142. pSource, pData: PByte;
  4143. begin
  4144. result := false;
  4145. if Assigned(Data) then begin
  4146. if Assigned(aBitmap) then begin
  4147. aBitmap.Width := Width;
  4148. aBitmap.Height := Height;
  4149. case Format of
  4150. tfAlpha8, tfLuminance8: begin
  4151. aBitmap.PixelFormat := pf8bit;
  4152. aBitmap.Palette := CreateGrayPalette;
  4153. end;
  4154. tfRGB5A1:
  4155. aBitmap.PixelFormat := pf15bit;
  4156. tfR5G6B5:
  4157. aBitmap.PixelFormat := pf16bit;
  4158. tfRGB8, tfBGR8:
  4159. aBitmap.PixelFormat := pf24bit;
  4160. tfRGBA8, tfBGRA8:
  4161. aBitmap.PixelFormat := pf32bit;
  4162. else
  4163. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4164. end;
  4165. pSource := Data;
  4166. for Row := 0 to FileHeight -1 do begin
  4167. pData := aBitmap.Scanline[Row];
  4168. Move(pSource^, pData^, fRowSize);
  4169. Inc(pSource, fRowSize);
  4170. if (Format in [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A)
  4171. SwapRGB(pData, FileWidth, Format = tfRGBA8);
  4172. end;
  4173. result := true;
  4174. end;
  4175. end;
  4176. end;
  4177. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4178. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4179. var
  4180. pSource, pData, pTempData: PByte;
  4181. Row, RowSize, TempWidth, TempHeight: Integer;
  4182. IntFormat: TglBitmapFormat;
  4183. begin
  4184. result := false;
  4185. if (Assigned(aBitmap)) then begin
  4186. case aBitmap.PixelFormat of
  4187. pf8bit:
  4188. IntFormat := tfLuminance8;
  4189. pf15bit:
  4190. IntFormat := tfRGB5A1;
  4191. pf16bit:
  4192. IntFormat := tfR5G6B5;
  4193. pf24bit:
  4194. IntFormat := tfBGR8;
  4195. pf32bit:
  4196. IntFormat := tfBGRA8;
  4197. else
  4198. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4199. end;
  4200. TempWidth := aBitmap.Width;
  4201. TempHeight := aBitmap.Height;
  4202. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4203. GetMem(pData, TempHeight * RowSize);
  4204. try
  4205. pTempData := pData;
  4206. for Row := 0 to TempHeight -1 do begin
  4207. pSource := aBitmap.Scanline[Row];
  4208. if (Assigned(pSource)) then begin
  4209. Move(pSource^, pTempData^, RowSize);
  4210. Inc(pTempData, RowSize);
  4211. end;
  4212. end;
  4213. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4214. result := true;
  4215. except
  4216. if Assigned(pData) then
  4217. FreeMem(pData);
  4218. raise;
  4219. end;
  4220. end;
  4221. end;
  4222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4223. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4224. var
  4225. Row, Col, AlphaInterleave: Integer;
  4226. pSource, pDest: PByte;
  4227. begin
  4228. result := false;
  4229. if Assigned(Data) then begin
  4230. if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
  4231. if Assigned(aBitmap) then begin
  4232. aBitmap.PixelFormat := pf8bit;
  4233. aBitmap.Palette := CreateGrayPalette;
  4234. aBitmap.Width := Width;
  4235. aBitmap.Height := Height;
  4236. case Format of
  4237. tfLuminance8Alpha8:
  4238. AlphaInterleave := 1;
  4239. tfRGBA8, tfBGRA8:
  4240. AlphaInterleave := 3;
  4241. else
  4242. AlphaInterleave := 0;
  4243. end;
  4244. // Copy Data
  4245. pSource := Data;
  4246. for Row := 0 to Height -1 do begin
  4247. pDest := aBitmap.Scanline[Row];
  4248. if Assigned(pDest) then begin
  4249. for Col := 0 to Width -1 do begin
  4250. Inc(pSource, AlphaInterleave);
  4251. pDest^ := pSource^;
  4252. Inc(pDest);
  4253. Inc(pSource);
  4254. end;
  4255. end;
  4256. end;
  4257. result := true;
  4258. end;
  4259. end;
  4260. end;
  4261. end;
  4262. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4263. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4264. var
  4265. tex: TglBitmap2D;
  4266. begin
  4267. tex := TglBitmap2D.Create;
  4268. try
  4269. tex.AssignFromBitmap(ABitmap);
  4270. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4271. finally
  4272. tex.Free;
  4273. end;
  4274. end;
  4275. {$ENDIF}
  4276. {$IFDEF GLB_LAZARUS}
  4277. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4278. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4279. var
  4280. rid: TRawImageDescription;
  4281. FormatDesc: TFormatDescriptor;
  4282. begin
  4283. result := false;
  4284. if not Assigned(aImage) or (Format = tfEmpty) then
  4285. exit;
  4286. FormatDesc := TFormatDescriptor.Get(Format);
  4287. if FormatDesc.IsCompressed then
  4288. exit;
  4289. FillChar(rid{%H-}, SizeOf(rid), 0);
  4290. if (Format in [
  4291. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  4292. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  4293. tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
  4294. rid.Format := ricfGray
  4295. else
  4296. rid.Format := ricfRGBA;
  4297. rid.Width := Width;
  4298. rid.Height := Height;
  4299. rid.Depth := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
  4300. rid.BitOrder := riboBitsInOrder;
  4301. rid.ByteOrder := riboLSBFirst;
  4302. rid.LineOrder := riloTopToBottom;
  4303. rid.LineEnd := rileTight;
  4304. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4305. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4306. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4307. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4308. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4309. rid.RedShift := FormatDesc.Shift.r;
  4310. rid.GreenShift := FormatDesc.Shift.g;
  4311. rid.BlueShift := FormatDesc.Shift.b;
  4312. rid.AlphaShift := FormatDesc.Shift.a;
  4313. rid.MaskBitsPerPixel := 0;
  4314. rid.PaletteColorCount := 0;
  4315. aImage.DataDescription := rid;
  4316. aImage.CreateData;
  4317. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4318. result := true;
  4319. end;
  4320. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4321. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4322. var
  4323. f: TglBitmapFormat;
  4324. FormatDesc: TFormatDescriptor;
  4325. ImageData: PByte;
  4326. ImageSize: Integer;
  4327. CanCopy: Boolean;
  4328. procedure CopyConvert;
  4329. var
  4330. bfFormat: TbmpBitfieldFormat;
  4331. pSourceLine, pDestLine: PByte;
  4332. pSourceMD, pDestMD: Pointer;
  4333. x, y: Integer;
  4334. pixel: TglBitmapPixelData;
  4335. begin
  4336. bfFormat := TbmpBitfieldFormat.Create;
  4337. with aImage.DataDescription do begin
  4338. bfFormat.RedMask := ((1 shl RedPrec) - 1) shl RedShift;
  4339. bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
  4340. bfFormat.BlueMask := ((1 shl BluePrec) - 1) shl BlueShift;
  4341. bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
  4342. bfFormat.PixelSize := BitsPerPixel / 8;
  4343. end;
  4344. pSourceMD := bfFormat.CreateMappingData;
  4345. pDestMD := FormatDesc.CreateMappingData;
  4346. try
  4347. for y := 0 to aImage.Height-1 do begin
  4348. pSourceLine := aImage.PixelData + y * aImage.DataDescription.BytesPerLine;
  4349. pDestLine := ImageData + y * Round(FormatDesc.PixelSize * aImage.Width);
  4350. for x := 0 to aImage.Width-1 do begin
  4351. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  4352. FormatDesc.Map(pixel, pDestLine, pDestMD);
  4353. end;
  4354. end;
  4355. finally
  4356. FormatDesc.FreeMappingData(pDestMD);
  4357. bfFormat.FreeMappingData(pSourceMD);
  4358. bfFormat.Free;
  4359. end;
  4360. end;
  4361. begin
  4362. result := false;
  4363. if not Assigned(aImage) then
  4364. exit;
  4365. for f := High(f) downto Low(f) do begin
  4366. FormatDesc := TFormatDescriptor.Get(f);
  4367. with aImage.DataDescription do
  4368. if FormatDesc.MaskMatch(
  4369. (QWord(1 shl RedPrec )-1) shl RedShift,
  4370. (QWord(1 shl GreenPrec)-1) shl GreenShift,
  4371. (QWord(1 shl BluePrec )-1) shl BlueShift,
  4372. (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
  4373. break;
  4374. end;
  4375. if (f = tfEmpty) then
  4376. exit;
  4377. CanCopy :=
  4378. (Round(FormatDesc.PixelSize * 8) = aImage.DataDescription.Depth) and
  4379. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  4380. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4381. ImageData := GetMem(ImageSize);
  4382. try
  4383. if CanCopy then
  4384. Move(aImage.PixelData^, ImageData^, ImageSize)
  4385. else
  4386. CopyConvert;
  4387. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4388. except
  4389. if Assigned(ImageData) then
  4390. FreeMem(ImageData);
  4391. raise;
  4392. end;
  4393. result := true;
  4394. end;
  4395. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4396. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4397. var
  4398. rid: TRawImageDescription;
  4399. FormatDesc: TFormatDescriptor;
  4400. Pixel: TglBitmapPixelData;
  4401. x, y: Integer;
  4402. srcMD: Pointer;
  4403. src, dst: PByte;
  4404. begin
  4405. result := false;
  4406. if not Assigned(aImage) or (Format = tfEmpty) then
  4407. exit;
  4408. FormatDesc := TFormatDescriptor.Get(Format);
  4409. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4410. exit;
  4411. FillChar(rid{%H-}, SizeOf(rid), 0);
  4412. rid.Format := ricfGray;
  4413. rid.Width := Width;
  4414. rid.Height := Height;
  4415. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4416. rid.BitOrder := riboBitsInOrder;
  4417. rid.ByteOrder := riboLSBFirst;
  4418. rid.LineOrder := riloTopToBottom;
  4419. rid.LineEnd := rileTight;
  4420. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4421. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4422. rid.GreenPrec := 0;
  4423. rid.BluePrec := 0;
  4424. rid.AlphaPrec := 0;
  4425. rid.RedShift := 0;
  4426. rid.GreenShift := 0;
  4427. rid.BlueShift := 0;
  4428. rid.AlphaShift := 0;
  4429. rid.MaskBitsPerPixel := 0;
  4430. rid.PaletteColorCount := 0;
  4431. aImage.DataDescription := rid;
  4432. aImage.CreateData;
  4433. srcMD := FormatDesc.CreateMappingData;
  4434. try
  4435. FormatDesc.PreparePixel(Pixel);
  4436. src := Data;
  4437. dst := aImage.PixelData;
  4438. for y := 0 to Height-1 do
  4439. for x := 0 to Width-1 do begin
  4440. FormatDesc.Unmap(src, Pixel, srcMD);
  4441. case rid.BitsPerPixel of
  4442. 8: begin
  4443. dst^ := Pixel.Data.a;
  4444. inc(dst);
  4445. end;
  4446. 16: begin
  4447. PWord(dst)^ := Pixel.Data.a;
  4448. inc(dst, 2);
  4449. end;
  4450. 24: begin
  4451. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4452. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4453. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4454. inc(dst, 3);
  4455. end;
  4456. 32: begin
  4457. PCardinal(dst)^ := Pixel.Data.a;
  4458. inc(dst, 4);
  4459. end;
  4460. else
  4461. raise EglBitmapUnsupportedFormat.Create(Format);
  4462. end;
  4463. end;
  4464. finally
  4465. FormatDesc.FreeMappingData(srcMD);
  4466. end;
  4467. result := true;
  4468. end;
  4469. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4470. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4471. var
  4472. tex: TglBitmap2D;
  4473. begin
  4474. tex := TglBitmap2D.Create;
  4475. try
  4476. tex.AssignFromLazIntfImage(aImage);
  4477. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4478. finally
  4479. tex.Free;
  4480. end;
  4481. end;
  4482. {$ENDIF}
  4483. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4484. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4485. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4486. var
  4487. rs: TResourceStream;
  4488. begin
  4489. PrepareResType(aResource, aResType);
  4490. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4491. try
  4492. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4493. finally
  4494. rs.Free;
  4495. end;
  4496. end;
  4497. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4498. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4499. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4500. var
  4501. rs: TResourceStream;
  4502. begin
  4503. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4504. try
  4505. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4506. finally
  4507. rs.Free;
  4508. end;
  4509. end;
  4510. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4511. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4512. begin
  4513. if TFormatDescriptor.Get(Format).IsCompressed then
  4514. raise EglBitmapUnsupportedFormat.Create(Format);
  4515. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4516. end;
  4517. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4518. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4519. var
  4520. FS: TFileStream;
  4521. begin
  4522. FS := TFileStream.Create(aFileName, fmOpenRead);
  4523. try
  4524. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4525. finally
  4526. FS.Free;
  4527. end;
  4528. end;
  4529. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4530. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4531. var
  4532. tex: TglBitmap2D;
  4533. begin
  4534. tex := TglBitmap2D.Create(aStream);
  4535. try
  4536. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4537. finally
  4538. tex.Free;
  4539. end;
  4540. end;
  4541. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4542. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4543. var
  4544. DestData, DestData2, SourceData: pByte;
  4545. TempHeight, TempWidth: Integer;
  4546. SourceFD, DestFD: TFormatDescriptor;
  4547. SourceMD, DestMD, DestMD2: Pointer;
  4548. FuncRec: TglBitmapFunctionRec;
  4549. begin
  4550. result := false;
  4551. Assert(Assigned(Data));
  4552. Assert(Assigned(aBitmap));
  4553. Assert(Assigned(aBitmap.Data));
  4554. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4555. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4556. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4557. DestFD := TFormatDescriptor.Get(Format);
  4558. if not Assigned(aFunc) then begin
  4559. aFunc := glBitmapAlphaFunc;
  4560. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4561. end else
  4562. FuncRec.Args := aArgs;
  4563. // Values
  4564. TempHeight := aBitmap.FileHeight;
  4565. TempWidth := aBitmap.FileWidth;
  4566. FuncRec.Sender := Self;
  4567. FuncRec.Size := Dimension;
  4568. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4569. DestData := Data;
  4570. DestData2 := Data;
  4571. SourceData := aBitmap.Data;
  4572. // Mapping
  4573. SourceFD.PreparePixel(FuncRec.Source);
  4574. DestFD.PreparePixel (FuncRec.Dest);
  4575. SourceMD := SourceFD.CreateMappingData;
  4576. DestMD := DestFD.CreateMappingData;
  4577. DestMD2 := DestFD.CreateMappingData;
  4578. try
  4579. FuncRec.Position.Y := 0;
  4580. while FuncRec.Position.Y < TempHeight do begin
  4581. FuncRec.Position.X := 0;
  4582. while FuncRec.Position.X < TempWidth do begin
  4583. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4584. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4585. aFunc(FuncRec);
  4586. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4587. inc(FuncRec.Position.X);
  4588. end;
  4589. inc(FuncRec.Position.Y);
  4590. end;
  4591. finally
  4592. SourceFD.FreeMappingData(SourceMD);
  4593. DestFD.FreeMappingData(DestMD);
  4594. DestFD.FreeMappingData(DestMD2);
  4595. end;
  4596. end;
  4597. end;
  4598. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4599. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4600. begin
  4601. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4602. end;
  4603. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4604. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4605. var
  4606. PixelData: TglBitmapPixelData;
  4607. begin
  4608. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4609. result := AddAlphaFromColorKeyFloat(
  4610. aRed / PixelData.Range.r,
  4611. aGreen / PixelData.Range.g,
  4612. aBlue / PixelData.Range.b,
  4613. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4614. end;
  4615. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4616. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4617. var
  4618. values: array[0..2] of Single;
  4619. tmp: Cardinal;
  4620. i: Integer;
  4621. PixelData: TglBitmapPixelData;
  4622. begin
  4623. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4624. with PixelData do begin
  4625. values[0] := aRed;
  4626. values[1] := aGreen;
  4627. values[2] := aBlue;
  4628. for i := 0 to 2 do begin
  4629. tmp := Trunc(Range.arr[i] * aDeviation);
  4630. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4631. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4632. end;
  4633. Data.a := 0;
  4634. Range.a := 0;
  4635. end;
  4636. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4637. end;
  4638. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4639. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4640. begin
  4641. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4642. end;
  4643. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4644. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4645. var
  4646. PixelData: TglBitmapPixelData;
  4647. begin
  4648. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4649. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4650. end;
  4651. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4652. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4653. var
  4654. PixelData: TglBitmapPixelData;
  4655. begin
  4656. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4657. with PixelData do
  4658. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4659. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4660. end;
  4661. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4662. function TglBitmap.RemoveAlpha: Boolean;
  4663. var
  4664. FormatDesc: TFormatDescriptor;
  4665. begin
  4666. result := false;
  4667. FormatDesc := TFormatDescriptor.Get(Format);
  4668. if Assigned(Data) then begin
  4669. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4670. raise EglBitmapUnsupportedFormat.Create(Format);
  4671. result := ConvertTo(FormatDesc.WithoutAlpha);
  4672. end;
  4673. end;
  4674. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4675. function TglBitmap.Clone: TglBitmap;
  4676. var
  4677. Temp: TglBitmap;
  4678. TempPtr: PByte;
  4679. Size: Integer;
  4680. begin
  4681. result := nil;
  4682. Temp := (ClassType.Create as TglBitmap);
  4683. try
  4684. // copy texture data if assigned
  4685. if Assigned(Data) then begin
  4686. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4687. GetMem(TempPtr, Size);
  4688. try
  4689. Move(Data^, TempPtr^, Size);
  4690. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4691. except
  4692. if Assigned(TempPtr) then
  4693. FreeMem(TempPtr);
  4694. raise;
  4695. end;
  4696. end else begin
  4697. TempPtr := nil;
  4698. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4699. end;
  4700. // copy properties
  4701. Temp.fID := ID;
  4702. Temp.fTarget := Target;
  4703. Temp.fFormat := Format;
  4704. Temp.fMipMap := MipMap;
  4705. Temp.fAnisotropic := Anisotropic;
  4706. Temp.fBorderColor := fBorderColor;
  4707. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4708. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4709. Temp.fFilterMin := fFilterMin;
  4710. Temp.fFilterMag := fFilterMag;
  4711. Temp.fWrapS := fWrapS;
  4712. Temp.fWrapT := fWrapT;
  4713. Temp.fWrapR := fWrapR;
  4714. Temp.fFilename := fFilename;
  4715. Temp.fCustomName := fCustomName;
  4716. Temp.fCustomNameW := fCustomNameW;
  4717. Temp.fCustomData := fCustomData;
  4718. result := Temp;
  4719. except
  4720. FreeAndNil(Temp);
  4721. raise;
  4722. end;
  4723. end;
  4724. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4725. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4726. var
  4727. SourceFD, DestFD: TFormatDescriptor;
  4728. SourcePD, DestPD: TglBitmapPixelData;
  4729. ShiftData: TShiftData;
  4730. function CanCopyDirect: Boolean;
  4731. begin
  4732. result :=
  4733. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4734. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4735. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4736. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4737. end;
  4738. function CanShift: Boolean;
  4739. begin
  4740. result :=
  4741. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4742. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4743. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4744. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4745. end;
  4746. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4747. begin
  4748. result := 0;
  4749. while (aSource > aDest) and (aSource > 0) do begin
  4750. inc(result);
  4751. aSource := aSource shr 1;
  4752. end;
  4753. end;
  4754. begin
  4755. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4756. SourceFD := TFormatDescriptor.Get(Format);
  4757. DestFD := TFormatDescriptor.Get(aFormat);
  4758. SourceFD.PreparePixel(SourcePD);
  4759. DestFD.PreparePixel (DestPD);
  4760. if CanCopyDirect then
  4761. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4762. else if CanShift then begin
  4763. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4764. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4765. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4766. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4767. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4768. end else
  4769. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4770. end else
  4771. result := true;
  4772. end;
  4773. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4774. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4775. begin
  4776. if aUseRGB or aUseAlpha then
  4777. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4778. ((Byte(aUseAlpha) and 1) shl 1) or
  4779. (Byte(aUseRGB) and 1) ));
  4780. end;
  4781. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4782. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4783. begin
  4784. fBorderColor[0] := aRed;
  4785. fBorderColor[1] := aGreen;
  4786. fBorderColor[2] := aBlue;
  4787. fBorderColor[3] := aAlpha;
  4788. if (ID > 0) then begin
  4789. Bind(false);
  4790. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4791. end;
  4792. end;
  4793. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4794. procedure TglBitmap.FreeData;
  4795. var
  4796. TempPtr: PByte;
  4797. begin
  4798. TempPtr := nil;
  4799. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  4800. end;
  4801. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4802. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4803. const aAlpha: Byte);
  4804. begin
  4805. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4806. end;
  4807. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4808. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4809. var
  4810. PixelData: TglBitmapPixelData;
  4811. begin
  4812. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4813. FillWithColorFloat(
  4814. aRed / PixelData.Range.r,
  4815. aGreen / PixelData.Range.g,
  4816. aBlue / PixelData.Range.b,
  4817. aAlpha / PixelData.Range.a);
  4818. end;
  4819. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4820. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4821. var
  4822. PixelData: TglBitmapPixelData;
  4823. begin
  4824. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4825. with PixelData do begin
  4826. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4827. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4828. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4829. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4830. end;
  4831. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4832. end;
  4833. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4834. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  4835. begin
  4836. //check MIN filter
  4837. case aMin of
  4838. GL_NEAREST:
  4839. fFilterMin := GL_NEAREST;
  4840. GL_LINEAR:
  4841. fFilterMin := GL_LINEAR;
  4842. GL_NEAREST_MIPMAP_NEAREST:
  4843. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4844. GL_LINEAR_MIPMAP_NEAREST:
  4845. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4846. GL_NEAREST_MIPMAP_LINEAR:
  4847. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4848. GL_LINEAR_MIPMAP_LINEAR:
  4849. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4850. else
  4851. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  4852. end;
  4853. //check MAG filter
  4854. case aMag of
  4855. GL_NEAREST:
  4856. fFilterMag := GL_NEAREST;
  4857. GL_LINEAR:
  4858. fFilterMag := GL_LINEAR;
  4859. else
  4860. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  4861. end;
  4862. //apply filter
  4863. if (ID > 0) then begin
  4864. Bind(false);
  4865. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4866. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4867. case fFilterMin of
  4868. GL_NEAREST, GL_LINEAR:
  4869. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4870. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4871. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4872. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4873. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4874. end;
  4875. end else
  4876. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4877. end;
  4878. end;
  4879. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4880. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  4881. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4882. begin
  4883. case aValue of
  4884. GL_CLAMP:
  4885. aTarget := GL_CLAMP;
  4886. GL_REPEAT:
  4887. aTarget := GL_REPEAT;
  4888. GL_CLAMP_TO_EDGE: begin
  4889. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4890. aTarget := GL_CLAMP_TO_EDGE
  4891. else
  4892. aTarget := GL_CLAMP;
  4893. end;
  4894. GL_CLAMP_TO_BORDER: begin
  4895. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4896. aTarget := GL_CLAMP_TO_BORDER
  4897. else
  4898. aTarget := GL_CLAMP;
  4899. end;
  4900. GL_MIRRORED_REPEAT: begin
  4901. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4902. aTarget := GL_MIRRORED_REPEAT
  4903. else
  4904. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4905. end;
  4906. else
  4907. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  4908. end;
  4909. end;
  4910. begin
  4911. CheckAndSetWrap(S, fWrapS);
  4912. CheckAndSetWrap(T, fWrapT);
  4913. CheckAndSetWrap(R, fWrapR);
  4914. if (ID > 0) then begin
  4915. Bind(false);
  4916. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4917. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4918. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4919. end;
  4920. end;
  4921. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4922. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  4923. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  4924. begin
  4925. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  4926. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  4927. fSwizzle[aIndex] := aValue
  4928. else
  4929. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  4930. end;
  4931. begin
  4932. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4933. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  4934. CheckAndSetValue(r, 0);
  4935. CheckAndSetValue(g, 1);
  4936. CheckAndSetValue(b, 2);
  4937. CheckAndSetValue(a, 3);
  4938. if (ID > 0) then begin
  4939. Bind(false);
  4940. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
  4941. end;
  4942. end;
  4943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4944. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4945. begin
  4946. if aEnableTextureUnit then
  4947. glEnable(Target);
  4948. if (ID > 0) then
  4949. glBindTexture(Target, ID);
  4950. end;
  4951. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4952. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4953. begin
  4954. if aDisableTextureUnit then
  4955. glDisable(Target);
  4956. glBindTexture(Target, 0);
  4957. end;
  4958. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4959. constructor TglBitmap.Create;
  4960. begin
  4961. if (ClassType = TglBitmap) then
  4962. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4963. {$IFDEF GLB_NATIVE_OGL}
  4964. glbReadOpenGLExtensions;
  4965. {$ENDIF}
  4966. inherited Create;
  4967. fFormat := glBitmapGetDefaultFormat;
  4968. fFreeDataOnDestroy := true;
  4969. end;
  4970. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4971. constructor TglBitmap.Create(const aFileName: String);
  4972. begin
  4973. Create;
  4974. LoadFromFile(aFileName);
  4975. end;
  4976. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4977. constructor TglBitmap.Create(const aStream: TStream);
  4978. begin
  4979. Create;
  4980. LoadFromStream(aStream);
  4981. end;
  4982. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4983. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
  4984. var
  4985. ImageSize: Integer;
  4986. begin
  4987. Create;
  4988. if not Assigned(aData) then begin
  4989. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4990. GetMem(aData, ImageSize);
  4991. try
  4992. FillChar(aData^, ImageSize, #$FF);
  4993. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4994. except
  4995. if Assigned(aData) then
  4996. FreeMem(aData);
  4997. raise;
  4998. end;
  4999. end else begin
  5000. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5001. fFreeDataOnDestroy := false;
  5002. end;
  5003. end;
  5004. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5005. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5006. begin
  5007. Create;
  5008. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  5009. end;
  5010. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5011. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  5012. begin
  5013. Create;
  5014. LoadFromResource(aInstance, aResource, aResType);
  5015. end;
  5016. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5017. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5018. begin
  5019. Create;
  5020. LoadFromResourceID(aInstance, aResourceID, aResType);
  5021. end;
  5022. {$IFDEF GLB_SUPPORT_PNG_READ}
  5023. {$IF DEFINED(GLB_LAZ_PNG)}
  5024. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5025. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5027. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5028. const
  5029. MAGIC_LEN = 8;
  5030. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  5031. var
  5032. reader: TLazReaderPNG;
  5033. intf: TLazIntfImage;
  5034. StreamPos: Int64;
  5035. magic: String[MAGIC_LEN];
  5036. begin
  5037. result := true;
  5038. StreamPos := aStream.Position;
  5039. SetLength(magic, MAGIC_LEN);
  5040. aStream.Read(magic[1], MAGIC_LEN);
  5041. aStream.Position := StreamPos;
  5042. if (magic <> PNG_MAGIC) then begin
  5043. result := false;
  5044. exit;
  5045. end;
  5046. intf := TLazIntfImage.Create(0, 0);
  5047. reader := TLazReaderPNG.Create;
  5048. try try
  5049. reader.UpdateDescription := true;
  5050. reader.ImageRead(aStream, intf);
  5051. AssignFromLazIntfImage(intf);
  5052. except
  5053. result := false;
  5054. aStream.Position := StreamPos;
  5055. exit;
  5056. end;
  5057. finally
  5058. reader.Free;
  5059. intf.Free;
  5060. end;
  5061. end;
  5062. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5063. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5064. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5065. var
  5066. Surface: PSDL_Surface;
  5067. RWops: PSDL_RWops;
  5068. begin
  5069. result := false;
  5070. RWops := glBitmapCreateRWops(aStream);
  5071. try
  5072. if IMG_isPNG(RWops) > 0 then begin
  5073. Surface := IMG_LoadPNG_RW(RWops);
  5074. try
  5075. AssignFromSurface(Surface);
  5076. result := true;
  5077. finally
  5078. SDL_FreeSurface(Surface);
  5079. end;
  5080. end;
  5081. finally
  5082. SDL_FreeRW(RWops);
  5083. end;
  5084. end;
  5085. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5086. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5087. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5088. begin
  5089. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5090. end;
  5091. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5092. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5093. var
  5094. StreamPos: Int64;
  5095. signature: array [0..7] of byte;
  5096. png: png_structp;
  5097. png_info: png_infop;
  5098. TempHeight, TempWidth: Integer;
  5099. Format: TglBitmapFormat;
  5100. png_data: pByte;
  5101. png_rows: array of pByte;
  5102. Row, LineSize: Integer;
  5103. begin
  5104. result := false;
  5105. if not init_libPNG then
  5106. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5107. try
  5108. // signature
  5109. StreamPos := aStream.Position;
  5110. aStream.Read(signature{%H-}, 8);
  5111. aStream.Position := StreamPos;
  5112. if png_check_sig(@signature, 8) <> 0 then begin
  5113. // png read struct
  5114. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5115. if png = nil then
  5116. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5117. // png info
  5118. png_info := png_create_info_struct(png);
  5119. if png_info = nil then begin
  5120. png_destroy_read_struct(@png, nil, nil);
  5121. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5122. end;
  5123. // set read callback
  5124. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5125. // read informations
  5126. png_read_info(png, png_info);
  5127. // size
  5128. TempHeight := png_get_image_height(png, png_info);
  5129. TempWidth := png_get_image_width(png, png_info);
  5130. // format
  5131. case png_get_color_type(png, png_info) of
  5132. PNG_COLOR_TYPE_GRAY:
  5133. Format := tfLuminance8;
  5134. PNG_COLOR_TYPE_GRAY_ALPHA:
  5135. Format := tfLuminance8Alpha8;
  5136. PNG_COLOR_TYPE_RGB:
  5137. Format := tfRGB8;
  5138. PNG_COLOR_TYPE_RGB_ALPHA:
  5139. Format := tfRGBA8;
  5140. else
  5141. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5142. end;
  5143. // cut upper 8 bit from 16 bit formats
  5144. if png_get_bit_depth(png, png_info) > 8 then
  5145. png_set_strip_16(png);
  5146. // expand bitdepth smaller than 8
  5147. if png_get_bit_depth(png, png_info) < 8 then
  5148. png_set_expand(png);
  5149. // allocating mem for scanlines
  5150. LineSize := png_get_rowbytes(png, png_info);
  5151. GetMem(png_data, TempHeight * LineSize);
  5152. try
  5153. SetLength(png_rows, TempHeight);
  5154. for Row := Low(png_rows) to High(png_rows) do begin
  5155. png_rows[Row] := png_data;
  5156. Inc(png_rows[Row], Row * LineSize);
  5157. end;
  5158. // read complete image into scanlines
  5159. png_read_image(png, @png_rows[0]);
  5160. // read end
  5161. png_read_end(png, png_info);
  5162. // destroy read struct
  5163. png_destroy_read_struct(@png, @png_info, nil);
  5164. SetLength(png_rows, 0);
  5165. // set new data
  5166. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5167. result := true;
  5168. except
  5169. if Assigned(png_data) then
  5170. FreeMem(png_data);
  5171. raise;
  5172. end;
  5173. end;
  5174. finally
  5175. quit_libPNG;
  5176. end;
  5177. end;
  5178. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5179. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5180. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5181. var
  5182. StreamPos: Int64;
  5183. Png: TPNGObject;
  5184. Header: String[8];
  5185. Row, Col, PixSize, LineSize: Integer;
  5186. NewImage, pSource, pDest, pAlpha: pByte;
  5187. PngFormat: TglBitmapFormat;
  5188. FormatDesc: TFormatDescriptor;
  5189. const
  5190. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5191. begin
  5192. result := false;
  5193. StreamPos := aStream.Position;
  5194. aStream.Read(Header[0], SizeOf(Header));
  5195. aStream.Position := StreamPos;
  5196. {Test if the header matches}
  5197. if Header = PngHeader then begin
  5198. Png := TPNGObject.Create;
  5199. try
  5200. Png.LoadFromStream(aStream);
  5201. case Png.Header.ColorType of
  5202. COLOR_GRAYSCALE:
  5203. PngFormat := tfLuminance8;
  5204. COLOR_GRAYSCALEALPHA:
  5205. PngFormat := tfLuminance8Alpha8;
  5206. COLOR_RGB:
  5207. PngFormat := tfBGR8;
  5208. COLOR_RGBALPHA:
  5209. PngFormat := tfBGRA8;
  5210. else
  5211. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5212. end;
  5213. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5214. PixSize := Round(FormatDesc.PixelSize);
  5215. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5216. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5217. try
  5218. pDest := NewImage;
  5219. case Png.Header.ColorType of
  5220. COLOR_RGB, COLOR_GRAYSCALE:
  5221. begin
  5222. for Row := 0 to Png.Height -1 do begin
  5223. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5224. Inc(pDest, LineSize);
  5225. end;
  5226. end;
  5227. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5228. begin
  5229. PixSize := PixSize -1;
  5230. for Row := 0 to Png.Height -1 do begin
  5231. pSource := Png.Scanline[Row];
  5232. pAlpha := pByte(Png.AlphaScanline[Row]);
  5233. for Col := 0 to Png.Width -1 do begin
  5234. Move (pSource^, pDest^, PixSize);
  5235. Inc(pSource, PixSize);
  5236. Inc(pDest, PixSize);
  5237. pDest^ := pAlpha^;
  5238. inc(pAlpha);
  5239. Inc(pDest);
  5240. end;
  5241. end;
  5242. end;
  5243. else
  5244. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5245. end;
  5246. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5247. result := true;
  5248. except
  5249. if Assigned(NewImage) then
  5250. FreeMem(NewImage);
  5251. raise;
  5252. end;
  5253. finally
  5254. Png.Free;
  5255. end;
  5256. end;
  5257. end;
  5258. {$IFEND}
  5259. {$ENDIF}
  5260. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5261. {$IFDEF GLB_LIB_PNG}
  5262. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5263. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5264. begin
  5265. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5266. end;
  5267. {$ENDIF}
  5268. {$IF DEFINED(GLB_LAZ_PNG)}
  5269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5270. procedure TglBitmap.SavePNG(const aStream: TStream);
  5271. var
  5272. png: TPortableNetworkGraphic;
  5273. intf: TLazIntfImage;
  5274. raw: TRawImage;
  5275. begin
  5276. png := TPortableNetworkGraphic.Create;
  5277. intf := TLazIntfImage.Create(0, 0);
  5278. try
  5279. if not AssignToLazIntfImage(intf) then
  5280. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5281. intf.GetRawImage(raw);
  5282. png.LoadFromRawImage(raw, false);
  5283. png.SaveToStream(aStream);
  5284. finally
  5285. png.Free;
  5286. intf.Free;
  5287. end;
  5288. end;
  5289. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5290. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5291. procedure TglBitmap.SavePNG(const aStream: TStream);
  5292. var
  5293. png: png_structp;
  5294. png_info: png_infop;
  5295. png_rows: array of pByte;
  5296. LineSize: Integer;
  5297. ColorType: Integer;
  5298. Row: Integer;
  5299. FormatDesc: TFormatDescriptor;
  5300. begin
  5301. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5302. raise EglBitmapUnsupportedFormat.Create(Format);
  5303. if not init_libPNG then
  5304. raise Exception.Create('unable to initialize libPNG.');
  5305. try
  5306. case Format of
  5307. tfAlpha8, tfLuminance8:
  5308. ColorType := PNG_COLOR_TYPE_GRAY;
  5309. tfLuminance8Alpha8:
  5310. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5311. tfBGR8, tfRGB8:
  5312. ColorType := PNG_COLOR_TYPE_RGB;
  5313. tfBGRA8, tfRGBA8:
  5314. ColorType := PNG_COLOR_TYPE_RGBA;
  5315. else
  5316. raise EglBitmapUnsupportedFormat.Create(Format);
  5317. end;
  5318. FormatDesc := TFormatDescriptor.Get(Format);
  5319. LineSize := FormatDesc.GetSize(Width, 1);
  5320. // creating array for scanline
  5321. SetLength(png_rows, Height);
  5322. try
  5323. for Row := 0 to Height - 1 do begin
  5324. png_rows[Row] := Data;
  5325. Inc(png_rows[Row], Row * LineSize)
  5326. end;
  5327. // write struct
  5328. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5329. if png = nil then
  5330. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5331. // create png info
  5332. png_info := png_create_info_struct(png);
  5333. if png_info = nil then begin
  5334. png_destroy_write_struct(@png, nil);
  5335. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5336. end;
  5337. // set read callback
  5338. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5339. // set compression
  5340. png_set_compression_level(png, 6);
  5341. if Format in [tfBGR8, tfBGRA8] then
  5342. png_set_bgr(png);
  5343. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5344. png_write_info(png, png_info);
  5345. png_write_image(png, @png_rows[0]);
  5346. png_write_end(png, png_info);
  5347. png_destroy_write_struct(@png, @png_info);
  5348. finally
  5349. SetLength(png_rows, 0);
  5350. end;
  5351. finally
  5352. quit_libPNG;
  5353. end;
  5354. end;
  5355. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5356. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5357. procedure TglBitmap.SavePNG(const aStream: TStream);
  5358. var
  5359. Png: TPNGObject;
  5360. pSource, pDest: pByte;
  5361. X, Y, PixSize: Integer;
  5362. ColorType: Cardinal;
  5363. Alpha: Boolean;
  5364. pTemp: pByte;
  5365. Temp: Byte;
  5366. begin
  5367. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5368. raise EglBitmapUnsupportedFormat.Create(Format);
  5369. case Format of
  5370. tfAlpha8, tfLuminance8: begin
  5371. ColorType := COLOR_GRAYSCALE;
  5372. PixSize := 1;
  5373. Alpha := false;
  5374. end;
  5375. tfLuminance8Alpha8: begin
  5376. ColorType := COLOR_GRAYSCALEALPHA;
  5377. PixSize := 1;
  5378. Alpha := true;
  5379. end;
  5380. tfBGR8, tfRGB8: begin
  5381. ColorType := COLOR_RGB;
  5382. PixSize := 3;
  5383. Alpha := false;
  5384. end;
  5385. tfBGRA8, tfRGBA8: begin
  5386. ColorType := COLOR_RGBALPHA;
  5387. PixSize := 3;
  5388. Alpha := true
  5389. end;
  5390. else
  5391. raise EglBitmapUnsupportedFormat.Create(Format);
  5392. end;
  5393. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5394. try
  5395. // Copy ImageData
  5396. pSource := Data;
  5397. for Y := 0 to Height -1 do begin
  5398. pDest := png.ScanLine[Y];
  5399. for X := 0 to Width -1 do begin
  5400. Move(pSource^, pDest^, PixSize);
  5401. Inc(pDest, PixSize);
  5402. Inc(pSource, PixSize);
  5403. if Alpha then begin
  5404. png.AlphaScanline[Y]^[X] := pSource^;
  5405. Inc(pSource);
  5406. end;
  5407. end;
  5408. // convert RGB line to BGR
  5409. if Format in [tfRGB8, tfRGBA8] then begin
  5410. pTemp := png.ScanLine[Y];
  5411. for X := 0 to Width -1 do begin
  5412. Temp := pByteArray(pTemp)^[0];
  5413. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5414. pByteArray(pTemp)^[2] := Temp;
  5415. Inc(pTemp, 3);
  5416. end;
  5417. end;
  5418. end;
  5419. // Save to Stream
  5420. Png.CompressionLevel := 6;
  5421. Png.SaveToStream(aStream);
  5422. finally
  5423. FreeAndNil(Png);
  5424. end;
  5425. end;
  5426. {$IFEND}
  5427. {$ENDIF}
  5428. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5429. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5430. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5431. {$IFDEF GLB_LIB_JPEG}
  5432. type
  5433. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5434. glBitmap_libJPEG_source_mgr = record
  5435. pub: jpeg_source_mgr;
  5436. SrcStream: TStream;
  5437. SrcBuffer: array [1..4096] of byte;
  5438. end;
  5439. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5440. glBitmap_libJPEG_dest_mgr = record
  5441. pub: jpeg_destination_mgr;
  5442. DestStream: TStream;
  5443. DestBuffer: array [1..4096] of byte;
  5444. end;
  5445. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5446. begin
  5447. //DUMMY
  5448. end;
  5449. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5450. begin
  5451. //DUMMY
  5452. end;
  5453. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5454. begin
  5455. //DUMMY
  5456. end;
  5457. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5458. begin
  5459. //DUMMY
  5460. end;
  5461. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5462. begin
  5463. //DUMMY
  5464. end;
  5465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5466. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5467. var
  5468. src: glBitmap_libJPEG_source_mgr_ptr;
  5469. bytes: integer;
  5470. begin
  5471. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5472. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5473. if (bytes <= 0) then begin
  5474. src^.SrcBuffer[1] := $FF;
  5475. src^.SrcBuffer[2] := JPEG_EOI;
  5476. bytes := 2;
  5477. end;
  5478. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5479. src^.pub.bytes_in_buffer := bytes;
  5480. result := true;
  5481. end;
  5482. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5483. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5484. var
  5485. src: glBitmap_libJPEG_source_mgr_ptr;
  5486. begin
  5487. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5488. if num_bytes > 0 then begin
  5489. // wanted byte isn't in buffer so set stream position and read buffer
  5490. if num_bytes > src^.pub.bytes_in_buffer then begin
  5491. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5492. src^.pub.fill_input_buffer(cinfo);
  5493. end else begin
  5494. // wanted byte is in buffer so only skip
  5495. inc(src^.pub.next_input_byte, num_bytes);
  5496. dec(src^.pub.bytes_in_buffer, num_bytes);
  5497. end;
  5498. end;
  5499. end;
  5500. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5501. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5502. var
  5503. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5504. begin
  5505. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5506. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5507. // write complete buffer
  5508. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5509. // reset buffer
  5510. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5511. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5512. end;
  5513. result := true;
  5514. end;
  5515. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5516. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5517. var
  5518. Idx: Integer;
  5519. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5520. begin
  5521. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5522. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5523. // check for endblock
  5524. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5525. // write endblock
  5526. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5527. // leave
  5528. break;
  5529. end else
  5530. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5531. end;
  5532. end;
  5533. {$ENDIF}
  5534. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5535. {$IF DEFINED(GLB_LAZ_JPEG)}
  5536. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5537. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5538. const
  5539. MAGIC_LEN = 2;
  5540. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  5541. var
  5542. jpeg: TJPEGImage;
  5543. intf: TLazIntfImage;
  5544. reader: TFPReaderJPEG;
  5545. StreamPos: Int64;
  5546. magic: String[MAGIC_LEN];
  5547. begin
  5548. result := true;
  5549. StreamPos := aStream.Position;
  5550. SetLength(magic, MAGIC_LEN);
  5551. aStream.Read(magic[1], MAGIC_LEN);
  5552. aStream.Position := StreamPos;
  5553. if (magic <> JPEG_MAGIC) then begin
  5554. result := false;
  5555. exit;
  5556. end;
  5557. reader := TFPReaderJPEG.Create;
  5558. intf := TLazIntfImage.Create(0, 0);
  5559. try try
  5560. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  5561. reader.ImageRead(aStream, intf);
  5562. AssignFromLazIntfImage(intf);
  5563. except
  5564. result := false;
  5565. aStream.Position := StreamPos;
  5566. exit;
  5567. end;
  5568. finally
  5569. reader.Free;
  5570. intf.Free;
  5571. end;
  5572. end;
  5573. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5574. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5575. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5576. var
  5577. Surface: PSDL_Surface;
  5578. RWops: PSDL_RWops;
  5579. begin
  5580. result := false;
  5581. RWops := glBitmapCreateRWops(aStream);
  5582. try
  5583. if IMG_isJPG(RWops) > 0 then begin
  5584. Surface := IMG_LoadJPG_RW(RWops);
  5585. try
  5586. AssignFromSurface(Surface);
  5587. result := true;
  5588. finally
  5589. SDL_FreeSurface(Surface);
  5590. end;
  5591. end;
  5592. finally
  5593. SDL_FreeRW(RWops);
  5594. end;
  5595. end;
  5596. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5597. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5598. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5599. var
  5600. StreamPos: Int64;
  5601. Temp: array[0..1]of Byte;
  5602. jpeg: jpeg_decompress_struct;
  5603. jpeg_err: jpeg_error_mgr;
  5604. IntFormat: TglBitmapFormat;
  5605. pImage: pByte;
  5606. TempHeight, TempWidth: Integer;
  5607. pTemp: pByte;
  5608. Row: Integer;
  5609. FormatDesc: TFormatDescriptor;
  5610. begin
  5611. result := false;
  5612. if not init_libJPEG then
  5613. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5614. try
  5615. // reading first two bytes to test file and set cursor back to begin
  5616. StreamPos := aStream.Position;
  5617. aStream.Read({%H-}Temp[0], 2);
  5618. aStream.Position := StreamPos;
  5619. // if Bitmap then read file.
  5620. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5621. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5622. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5623. // error managment
  5624. jpeg.err := jpeg_std_error(@jpeg_err);
  5625. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5626. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5627. // decompression struct
  5628. jpeg_create_decompress(@jpeg);
  5629. // allocation space for streaming methods
  5630. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5631. // seeting up custom functions
  5632. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5633. pub.init_source := glBitmap_libJPEG_init_source;
  5634. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5635. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5636. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5637. pub.term_source := glBitmap_libJPEG_term_source;
  5638. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5639. pub.next_input_byte := nil; // until buffer loaded
  5640. SrcStream := aStream;
  5641. end;
  5642. // set global decoding state
  5643. jpeg.global_state := DSTATE_START;
  5644. // read header of jpeg
  5645. jpeg_read_header(@jpeg, false);
  5646. // setting output parameter
  5647. case jpeg.jpeg_color_space of
  5648. JCS_GRAYSCALE:
  5649. begin
  5650. jpeg.out_color_space := JCS_GRAYSCALE;
  5651. IntFormat := tfLuminance8;
  5652. end;
  5653. else
  5654. jpeg.out_color_space := JCS_RGB;
  5655. IntFormat := tfRGB8;
  5656. end;
  5657. // reading image
  5658. jpeg_start_decompress(@jpeg);
  5659. TempHeight := jpeg.output_height;
  5660. TempWidth := jpeg.output_width;
  5661. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5662. // creating new image
  5663. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5664. try
  5665. pTemp := pImage;
  5666. for Row := 0 to TempHeight -1 do begin
  5667. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5668. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5669. end;
  5670. // finish decompression
  5671. jpeg_finish_decompress(@jpeg);
  5672. // destroy decompression
  5673. jpeg_destroy_decompress(@jpeg);
  5674. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5675. result := true;
  5676. except
  5677. if Assigned(pImage) then
  5678. FreeMem(pImage);
  5679. raise;
  5680. end;
  5681. end;
  5682. finally
  5683. quit_libJPEG;
  5684. end;
  5685. end;
  5686. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5687. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5688. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5689. var
  5690. bmp: TBitmap;
  5691. jpg: TJPEGImage;
  5692. StreamPos: Int64;
  5693. Temp: array[0..1]of Byte;
  5694. begin
  5695. result := false;
  5696. // reading first two bytes to test file and set cursor back to begin
  5697. StreamPos := aStream.Position;
  5698. aStream.Read(Temp[0], 2);
  5699. aStream.Position := StreamPos;
  5700. // if Bitmap then read file.
  5701. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5702. bmp := TBitmap.Create;
  5703. try
  5704. jpg := TJPEGImage.Create;
  5705. try
  5706. jpg.LoadFromStream(aStream);
  5707. bmp.Assign(jpg);
  5708. result := AssignFromBitmap(bmp);
  5709. finally
  5710. jpg.Free;
  5711. end;
  5712. finally
  5713. bmp.Free;
  5714. end;
  5715. end;
  5716. end;
  5717. {$IFEND}
  5718. {$ENDIF}
  5719. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5720. {$IF DEFINED(GLB_LAZ_JPEG)}
  5721. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5722. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5723. var
  5724. jpeg: TJPEGImage;
  5725. intf: TLazIntfImage;
  5726. raw: TRawImage;
  5727. begin
  5728. jpeg := TJPEGImage.Create;
  5729. intf := TLazIntfImage.Create(0, 0);
  5730. try
  5731. if not AssignToLazIntfImage(intf) then
  5732. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5733. intf.GetRawImage(raw);
  5734. jpeg.LoadFromRawImage(raw, false);
  5735. jpeg.SaveToStream(aStream);
  5736. finally
  5737. intf.Free;
  5738. jpeg.Free;
  5739. end;
  5740. end;
  5741. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5742. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5743. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5744. var
  5745. jpeg: jpeg_compress_struct;
  5746. jpeg_err: jpeg_error_mgr;
  5747. Row: Integer;
  5748. pTemp, pTemp2: pByte;
  5749. procedure CopyRow(pDest, pSource: pByte);
  5750. var
  5751. X: Integer;
  5752. begin
  5753. for X := 0 to Width - 1 do begin
  5754. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5755. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5756. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5757. Inc(pDest, 3);
  5758. Inc(pSource, 3);
  5759. end;
  5760. end;
  5761. begin
  5762. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5763. raise EglBitmapUnsupportedFormat.Create(Format);
  5764. if not init_libJPEG then
  5765. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5766. try
  5767. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  5768. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5769. // error managment
  5770. jpeg.err := jpeg_std_error(@jpeg_err);
  5771. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5772. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5773. // compression struct
  5774. jpeg_create_compress(@jpeg);
  5775. // allocation space for streaming methods
  5776. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5777. // seeting up custom functions
  5778. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5779. pub.init_destination := glBitmap_libJPEG_init_destination;
  5780. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5781. pub.term_destination := glBitmap_libJPEG_term_destination;
  5782. pub.next_output_byte := @DestBuffer[1];
  5783. pub.free_in_buffer := Length(DestBuffer);
  5784. DestStream := aStream;
  5785. end;
  5786. // very important state
  5787. jpeg.global_state := CSTATE_START;
  5788. jpeg.image_width := Width;
  5789. jpeg.image_height := Height;
  5790. case Format of
  5791. tfAlpha8, tfLuminance8: begin
  5792. jpeg.input_components := 1;
  5793. jpeg.in_color_space := JCS_GRAYSCALE;
  5794. end;
  5795. tfRGB8, tfBGR8: begin
  5796. jpeg.input_components := 3;
  5797. jpeg.in_color_space := JCS_RGB;
  5798. end;
  5799. end;
  5800. jpeg_set_defaults(@jpeg);
  5801. jpeg_set_quality(@jpeg, 95, true);
  5802. jpeg_start_compress(@jpeg, true);
  5803. pTemp := Data;
  5804. if Format = tfBGR8 then
  5805. GetMem(pTemp2, fRowSize)
  5806. else
  5807. pTemp2 := pTemp;
  5808. try
  5809. for Row := 0 to jpeg.image_height -1 do begin
  5810. // prepare row
  5811. if Format = tfBGR8 then
  5812. CopyRow(pTemp2, pTemp)
  5813. else
  5814. pTemp2 := pTemp;
  5815. // write row
  5816. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5817. inc(pTemp, fRowSize);
  5818. end;
  5819. finally
  5820. // free memory
  5821. if Format = tfBGR8 then
  5822. FreeMem(pTemp2);
  5823. end;
  5824. jpeg_finish_compress(@jpeg);
  5825. jpeg_destroy_compress(@jpeg);
  5826. finally
  5827. quit_libJPEG;
  5828. end;
  5829. end;
  5830. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5831. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5832. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5833. var
  5834. Bmp: TBitmap;
  5835. Jpg: TJPEGImage;
  5836. begin
  5837. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5838. raise EglBitmapUnsupportedFormat.Create(Format);
  5839. Bmp := TBitmap.Create;
  5840. try
  5841. Jpg := TJPEGImage.Create;
  5842. try
  5843. AssignToBitmap(Bmp);
  5844. if (Format in [tfAlpha8, tfLuminance8]) then begin
  5845. Jpg.Grayscale := true;
  5846. Jpg.PixelFormat := jf8Bit;
  5847. end;
  5848. Jpg.Assign(Bmp);
  5849. Jpg.SaveToStream(aStream);
  5850. finally
  5851. FreeAndNil(Jpg);
  5852. end;
  5853. finally
  5854. FreeAndNil(Bmp);
  5855. end;
  5856. end;
  5857. {$IFEND}
  5858. {$ENDIF}
  5859. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5860. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5861. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5862. const
  5863. BMP_MAGIC = $4D42;
  5864. BMP_COMP_RGB = 0;
  5865. BMP_COMP_RLE8 = 1;
  5866. BMP_COMP_RLE4 = 2;
  5867. BMP_COMP_BITFIELDS = 3;
  5868. type
  5869. TBMPHeader = packed record
  5870. bfType: Word;
  5871. bfSize: Cardinal;
  5872. bfReserved1: Word;
  5873. bfReserved2: Word;
  5874. bfOffBits: Cardinal;
  5875. end;
  5876. TBMPInfo = packed record
  5877. biSize: Cardinal;
  5878. biWidth: Longint;
  5879. biHeight: Longint;
  5880. biPlanes: Word;
  5881. biBitCount: Word;
  5882. biCompression: Cardinal;
  5883. biSizeImage: Cardinal;
  5884. biXPelsPerMeter: Longint;
  5885. biYPelsPerMeter: Longint;
  5886. biClrUsed: Cardinal;
  5887. biClrImportant: Cardinal;
  5888. end;
  5889. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5890. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5891. //////////////////////////////////////////////////////////////////////////////////////////////////
  5892. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5893. begin
  5894. result := tfEmpty;
  5895. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5896. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5897. //Read Compression
  5898. case aInfo.biCompression of
  5899. BMP_COMP_RLE4,
  5900. BMP_COMP_RLE8: begin
  5901. raise EglBitmap.Create('RLE compression is not supported');
  5902. end;
  5903. BMP_COMP_BITFIELDS: begin
  5904. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5905. aStream.Read(aMask.r, SizeOf(aMask.r));
  5906. aStream.Read(aMask.g, SizeOf(aMask.g));
  5907. aStream.Read(aMask.b, SizeOf(aMask.b));
  5908. aStream.Read(aMask.a, SizeOf(aMask.a));
  5909. end else
  5910. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  5911. end;
  5912. end;
  5913. //get suitable format
  5914. case aInfo.biBitCount of
  5915. 8: result := tfLuminance8;
  5916. 16: result := tfBGR5;
  5917. 24: result := tfBGR8;
  5918. 32: result := tfBGRA8;
  5919. end;
  5920. end;
  5921. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5922. var
  5923. i, c: Integer;
  5924. ColorTable: TbmpColorTable;
  5925. begin
  5926. result := nil;
  5927. if (aInfo.biBitCount >= 16) then
  5928. exit;
  5929. aFormat := tfLuminance8;
  5930. c := aInfo.biClrUsed;
  5931. if (c = 0) then
  5932. c := 1 shl aInfo.biBitCount;
  5933. SetLength(ColorTable, c);
  5934. for i := 0 to c-1 do begin
  5935. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5936. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5937. aFormat := tfRGB8;
  5938. end;
  5939. result := TbmpColorTableFormat.Create;
  5940. result.PixelSize := aInfo.biBitCount / 8;
  5941. result.ColorTable := ColorTable;
  5942. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5943. end;
  5944. //////////////////////////////////////////////////////////////////////////////////////////////////
  5945. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5946. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5947. var
  5948. TmpFormat: TglBitmapFormat;
  5949. FormatDesc: TFormatDescriptor;
  5950. begin
  5951. result := nil;
  5952. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5953. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5954. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5955. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5956. aFormat := FormatDesc.Format;
  5957. exit;
  5958. end;
  5959. end;
  5960. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5961. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5962. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5963. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5964. result := TbmpBitfieldFormat.Create;
  5965. result.PixelSize := aInfo.biBitCount / 8;
  5966. result.RedMask := aMask.r;
  5967. result.GreenMask := aMask.g;
  5968. result.BlueMask := aMask.b;
  5969. result.AlphaMask := aMask.a;
  5970. end;
  5971. end;
  5972. var
  5973. //simple types
  5974. StartPos: Int64;
  5975. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5976. PaddingBuff: Cardinal;
  5977. LineBuf, ImageData, TmpData: PByte;
  5978. SourceMD, DestMD: Pointer;
  5979. BmpFormat: TglBitmapFormat;
  5980. //records
  5981. Mask: TglBitmapColorRec;
  5982. Header: TBMPHeader;
  5983. Info: TBMPInfo;
  5984. //classes
  5985. SpecialFormat: TFormatDescriptor;
  5986. FormatDesc: TFormatDescriptor;
  5987. //////////////////////////////////////////////////////////////////////////////////////////////////
  5988. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  5989. var
  5990. i: Integer;
  5991. Pixel: TglBitmapPixelData;
  5992. begin
  5993. aStream.Read(aLineBuf^, rbLineSize);
  5994. SpecialFormat.PreparePixel(Pixel);
  5995. for i := 0 to Info.biWidth-1 do begin
  5996. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  5997. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  5998. FormatDesc.Map(Pixel, aData, DestMD);
  5999. end;
  6000. end;
  6001. begin
  6002. result := false;
  6003. BmpFormat := tfEmpty;
  6004. SpecialFormat := nil;
  6005. LineBuf := nil;
  6006. SourceMD := nil;
  6007. DestMD := nil;
  6008. // Header
  6009. StartPos := aStream.Position;
  6010. aStream.Read(Header{%H-}, SizeOf(Header));
  6011. if Header.bfType = BMP_MAGIC then begin
  6012. try try
  6013. BmpFormat := ReadInfo(Info, Mask);
  6014. SpecialFormat := ReadColorTable(BmpFormat, Info);
  6015. if not Assigned(SpecialFormat) then
  6016. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  6017. aStream.Position := StartPos + Header.bfOffBits;
  6018. if (BmpFormat <> tfEmpty) then begin
  6019. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  6020. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  6021. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  6022. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  6023. //get Memory
  6024. DestMD := FormatDesc.CreateMappingData;
  6025. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  6026. GetMem(ImageData, ImageSize);
  6027. if Assigned(SpecialFormat) then begin
  6028. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  6029. SourceMD := SpecialFormat.CreateMappingData;
  6030. end;
  6031. //read Data
  6032. try try
  6033. FillChar(ImageData^, ImageSize, $FF);
  6034. TmpData := ImageData;
  6035. if (Info.biHeight > 0) then
  6036. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  6037. for i := 0 to Abs(Info.biHeight)-1 do begin
  6038. if Assigned(SpecialFormat) then
  6039. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  6040. else
  6041. aStream.Read(TmpData^, wbLineSize); //else only read data
  6042. if (Info.biHeight > 0) then
  6043. dec(TmpData, wbLineSize)
  6044. else
  6045. inc(TmpData, wbLineSize);
  6046. aStream.Read(PaddingBuff{%H-}, Padding);
  6047. end;
  6048. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6049. result := true;
  6050. finally
  6051. if Assigned(LineBuf) then
  6052. FreeMem(LineBuf);
  6053. if Assigned(SourceMD) then
  6054. SpecialFormat.FreeMappingData(SourceMD);
  6055. FormatDesc.FreeMappingData(DestMD);
  6056. end;
  6057. except
  6058. if Assigned(ImageData) then
  6059. FreeMem(ImageData);
  6060. raise;
  6061. end;
  6062. end else
  6063. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6064. except
  6065. aStream.Position := StartPos;
  6066. raise;
  6067. end;
  6068. finally
  6069. FreeAndNil(SpecialFormat);
  6070. end;
  6071. end
  6072. else aStream.Position := StartPos;
  6073. end;
  6074. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6075. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6076. var
  6077. Header: TBMPHeader;
  6078. Info: TBMPInfo;
  6079. Converter: TFormatDescriptor;
  6080. FormatDesc: TFormatDescriptor;
  6081. SourceFD, DestFD: Pointer;
  6082. pData, srcData, dstData, ConvertBuffer: pByte;
  6083. Pixel: TglBitmapPixelData;
  6084. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6085. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6086. PaddingBuff: Cardinal;
  6087. function GetLineWidth : Integer;
  6088. begin
  6089. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6090. end;
  6091. begin
  6092. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6093. raise EglBitmapUnsupportedFormat.Create(Format);
  6094. Converter := nil;
  6095. FormatDesc := TFormatDescriptor.Get(Format);
  6096. ImageSize := FormatDesc.GetSize(Dimension);
  6097. FillChar(Header{%H-}, SizeOf(Header), 0);
  6098. Header.bfType := BMP_MAGIC;
  6099. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6100. Header.bfReserved1 := 0;
  6101. Header.bfReserved2 := 0;
  6102. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6103. FillChar(Info{%H-}, SizeOf(Info), 0);
  6104. Info.biSize := SizeOf(Info);
  6105. Info.biWidth := Width;
  6106. Info.biHeight := Height;
  6107. Info.biPlanes := 1;
  6108. Info.biCompression := BMP_COMP_RGB;
  6109. Info.biSizeImage := ImageSize;
  6110. try
  6111. case Format of
  6112. tfLuminance4: begin
  6113. Info.biBitCount := 4;
  6114. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  6115. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  6116. Converter := TbmpColorTableFormat.Create;
  6117. with (Converter as TbmpColorTableFormat) do begin
  6118. PixelSize := 0.5;
  6119. Format := Format;
  6120. Range := glBitmapColorRec($F, $F, $F, $0);
  6121. CreateColorTable;
  6122. end;
  6123. end;
  6124. tfR3G3B2, tfLuminance8: begin
  6125. Info.biBitCount := 8;
  6126. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6127. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6128. Converter := TbmpColorTableFormat.Create;
  6129. with (Converter as TbmpColorTableFormat) do begin
  6130. PixelSize := 1;
  6131. Format := Format;
  6132. if (Format = tfR3G3B2) then begin
  6133. Range := glBitmapColorRec($7, $7, $3, $0);
  6134. Shift := glBitmapShiftRec(0, 3, 6, 0);
  6135. end else
  6136. Range := glBitmapColorRec($FF, $FF, $FF, $0);
  6137. CreateColorTable;
  6138. end;
  6139. end;
  6140. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  6141. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  6142. Info.biBitCount := 16;
  6143. Info.biCompression := BMP_COMP_BITFIELDS;
  6144. end;
  6145. tfBGR8, tfRGB8: begin
  6146. Info.biBitCount := 24;
  6147. if (Format = tfRGB8) then
  6148. Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6149. end;
  6150. tfRGB10, tfRGB10A2, tfRGBA8,
  6151. tfBGR10, tfBGR10A2, tfBGRA8: begin
  6152. Info.biBitCount := 32;
  6153. Info.biCompression := BMP_COMP_BITFIELDS;
  6154. end;
  6155. else
  6156. raise EglBitmapUnsupportedFormat.Create(Format);
  6157. end;
  6158. Info.biXPelsPerMeter := 2835;
  6159. Info.biYPelsPerMeter := 2835;
  6160. // prepare bitmasks
  6161. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6162. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6163. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6164. RedMask := FormatDesc.RedMask;
  6165. GreenMask := FormatDesc.GreenMask;
  6166. BlueMask := FormatDesc.BlueMask;
  6167. AlphaMask := FormatDesc.AlphaMask;
  6168. end;
  6169. // headers
  6170. aStream.Write(Header, SizeOf(Header));
  6171. aStream.Write(Info, SizeOf(Info));
  6172. // colortable
  6173. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6174. with (Converter as TbmpColorTableFormat) do
  6175. aStream.Write(ColorTable[0].b,
  6176. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6177. // bitmasks
  6178. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6179. aStream.Write(RedMask, SizeOf(Cardinal));
  6180. aStream.Write(GreenMask, SizeOf(Cardinal));
  6181. aStream.Write(BlueMask, SizeOf(Cardinal));
  6182. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6183. end;
  6184. // image data
  6185. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  6186. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6187. Padding := GetLineWidth - wbLineSize;
  6188. PaddingBuff := 0;
  6189. pData := Data;
  6190. inc(pData, (Height-1) * rbLineSize);
  6191. // prepare row buffer. But only for RGB because RGBA supports color masks
  6192. // so it's possible to change color within the image.
  6193. if Assigned(Converter) then begin
  6194. FormatDesc.PreparePixel(Pixel);
  6195. GetMem(ConvertBuffer, wbLineSize);
  6196. SourceFD := FormatDesc.CreateMappingData;
  6197. DestFD := Converter.CreateMappingData;
  6198. end else
  6199. ConvertBuffer := nil;
  6200. try
  6201. for LineIdx := 0 to Height - 1 do begin
  6202. // preparing row
  6203. if Assigned(Converter) then begin
  6204. srcData := pData;
  6205. dstData := ConvertBuffer;
  6206. for PixelIdx := 0 to Info.biWidth-1 do begin
  6207. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6208. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6209. Converter.Map(Pixel, dstData, DestFD);
  6210. end;
  6211. aStream.Write(ConvertBuffer^, wbLineSize);
  6212. end else begin
  6213. aStream.Write(pData^, rbLineSize);
  6214. end;
  6215. dec(pData, rbLineSize);
  6216. if (Padding > 0) then
  6217. aStream.Write(PaddingBuff, Padding);
  6218. end;
  6219. finally
  6220. // destroy row buffer
  6221. if Assigned(ConvertBuffer) then begin
  6222. FormatDesc.FreeMappingData(SourceFD);
  6223. Converter.FreeMappingData(DestFD);
  6224. FreeMem(ConvertBuffer);
  6225. end;
  6226. end;
  6227. finally
  6228. if Assigned(Converter) then
  6229. Converter.Free;
  6230. end;
  6231. end;
  6232. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6233. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6234. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6235. type
  6236. TTGAHeader = packed record
  6237. ImageID: Byte;
  6238. ColorMapType: Byte;
  6239. ImageType: Byte;
  6240. //ColorMapSpec: Array[0..4] of Byte;
  6241. ColorMapStart: Word;
  6242. ColorMapLength: Word;
  6243. ColorMapEntrySize: Byte;
  6244. OrigX: Word;
  6245. OrigY: Word;
  6246. Width: Word;
  6247. Height: Word;
  6248. Bpp: Byte;
  6249. ImageDesc: Byte;
  6250. end;
  6251. const
  6252. TGA_UNCOMPRESSED_RGB = 2;
  6253. TGA_UNCOMPRESSED_GRAY = 3;
  6254. TGA_COMPRESSED_RGB = 10;
  6255. TGA_COMPRESSED_GRAY = 11;
  6256. TGA_NONE_COLOR_TABLE = 0;
  6257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6258. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6259. var
  6260. Header: TTGAHeader;
  6261. ImageData: System.PByte;
  6262. StartPosition: Int64;
  6263. PixelSize, LineSize: Integer;
  6264. tgaFormat: TglBitmapFormat;
  6265. FormatDesc: TFormatDescriptor;
  6266. Counter: packed record
  6267. X, Y: packed record
  6268. low, high, dir: Integer;
  6269. end;
  6270. end;
  6271. const
  6272. CACHE_SIZE = $4000;
  6273. ////////////////////////////////////////////////////////////////////////////////////////
  6274. procedure ReadUncompressed;
  6275. var
  6276. i, j: Integer;
  6277. buf, tmp1, tmp2: System.PByte;
  6278. begin
  6279. buf := nil;
  6280. if (Counter.X.dir < 0) then
  6281. GetMem(buf, LineSize);
  6282. try
  6283. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6284. tmp1 := ImageData;
  6285. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6286. if (Counter.X.dir < 0) then begin //flip X
  6287. aStream.Read(buf^, LineSize);
  6288. tmp2 := buf;
  6289. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6290. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6291. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6292. tmp1^ := tmp2^;
  6293. inc(tmp1);
  6294. inc(tmp2);
  6295. end;
  6296. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6297. end;
  6298. end else
  6299. aStream.Read(tmp1^, LineSize);
  6300. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6301. end;
  6302. finally
  6303. if Assigned(buf) then
  6304. FreeMem(buf);
  6305. end;
  6306. end;
  6307. ////////////////////////////////////////////////////////////////////////////////////////
  6308. procedure ReadCompressed;
  6309. /////////////////////////////////////////////////////////////////
  6310. var
  6311. TmpData: System.PByte;
  6312. LinePixelsRead: Integer;
  6313. procedure CheckLine;
  6314. begin
  6315. if (LinePixelsRead >= Header.Width) then begin
  6316. LinePixelsRead := 0;
  6317. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6318. TmpData := ImageData;
  6319. inc(TmpData, Counter.Y.low * LineSize); //set line
  6320. if (Counter.X.dir < 0) then //if x flipped then
  6321. inc(TmpData, LineSize - PixelSize); //set last pixel
  6322. end;
  6323. end;
  6324. /////////////////////////////////////////////////////////////////
  6325. var
  6326. Cache: PByte;
  6327. CacheSize, CachePos: Integer;
  6328. procedure CachedRead(out Buffer; Count: Integer);
  6329. var
  6330. BytesRead: Integer;
  6331. begin
  6332. if (CachePos + Count > CacheSize) then begin
  6333. //if buffer overflow save non read bytes
  6334. BytesRead := 0;
  6335. if (CacheSize - CachePos > 0) then begin
  6336. BytesRead := CacheSize - CachePos;
  6337. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6338. inc(CachePos, BytesRead);
  6339. end;
  6340. //load cache from file
  6341. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6342. aStream.Read(Cache^, CacheSize);
  6343. CachePos := 0;
  6344. //read rest of requested bytes
  6345. if (Count - BytesRead > 0) then begin
  6346. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6347. inc(CachePos, Count - BytesRead);
  6348. end;
  6349. end else begin
  6350. //if no buffer overflow just read the data
  6351. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6352. inc(CachePos, Count);
  6353. end;
  6354. end;
  6355. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6356. begin
  6357. case PixelSize of
  6358. 1: begin
  6359. aBuffer^ := aData^;
  6360. inc(aBuffer, Counter.X.dir);
  6361. end;
  6362. 2: begin
  6363. PWord(aBuffer)^ := PWord(aData)^;
  6364. inc(aBuffer, 2 * Counter.X.dir);
  6365. end;
  6366. 3: begin
  6367. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6368. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6369. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6370. inc(aBuffer, 3 * Counter.X.dir);
  6371. end;
  6372. 4: begin
  6373. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6374. inc(aBuffer, 4 * Counter.X.dir);
  6375. end;
  6376. end;
  6377. end;
  6378. var
  6379. TotalPixelsToRead, TotalPixelsRead: Integer;
  6380. Temp: Byte;
  6381. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6382. PixelRepeat: Boolean;
  6383. PixelsToRead, PixelCount: Integer;
  6384. begin
  6385. CacheSize := 0;
  6386. CachePos := 0;
  6387. TotalPixelsToRead := Header.Width * Header.Height;
  6388. TotalPixelsRead := 0;
  6389. LinePixelsRead := 0;
  6390. GetMem(Cache, CACHE_SIZE);
  6391. try
  6392. TmpData := ImageData;
  6393. inc(TmpData, Counter.Y.low * LineSize); //set line
  6394. if (Counter.X.dir < 0) then //if x flipped then
  6395. inc(TmpData, LineSize - PixelSize); //set last pixel
  6396. repeat
  6397. //read CommandByte
  6398. CachedRead(Temp, 1);
  6399. PixelRepeat := (Temp and $80) > 0;
  6400. PixelsToRead := (Temp and $7F) + 1;
  6401. inc(TotalPixelsRead, PixelsToRead);
  6402. if PixelRepeat then
  6403. CachedRead(buf[0], PixelSize);
  6404. while (PixelsToRead > 0) do begin
  6405. CheckLine;
  6406. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6407. while (PixelCount > 0) do begin
  6408. if not PixelRepeat then
  6409. CachedRead(buf[0], PixelSize);
  6410. PixelToBuffer(@buf[0], TmpData);
  6411. inc(LinePixelsRead);
  6412. dec(PixelsToRead);
  6413. dec(PixelCount);
  6414. end;
  6415. end;
  6416. until (TotalPixelsRead >= TotalPixelsToRead);
  6417. finally
  6418. FreeMem(Cache);
  6419. end;
  6420. end;
  6421. function IsGrayFormat: Boolean;
  6422. begin
  6423. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6424. end;
  6425. begin
  6426. result := false;
  6427. // reading header to test file and set cursor back to begin
  6428. StartPosition := aStream.Position;
  6429. aStream.Read(Header{%H-}, SizeOf(Header));
  6430. // no colormapped files
  6431. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6432. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6433. begin
  6434. try
  6435. if Header.ImageID <> 0 then // skip image ID
  6436. aStream.Position := aStream.Position + Header.ImageID;
  6437. tgaFormat := tfEmpty;
  6438. case Header.Bpp of
  6439. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6440. 0: tgaFormat := tfLuminance8;
  6441. 8: tgaFormat := tfAlpha8;
  6442. end;
  6443. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6444. 0: tgaFormat := tfLuminance16;
  6445. 8: tgaFormat := tfLuminance8Alpha8;
  6446. end else case (Header.ImageDesc and $F) of
  6447. 0: tgaFormat := tfBGR5;
  6448. 1: tgaFormat := tfBGR5A1;
  6449. 4: tgaFormat := tfBGRA4;
  6450. end;
  6451. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6452. 0: tgaFormat := tfBGR8;
  6453. end;
  6454. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6455. 2: tgaFormat := tfBGR10A2;
  6456. 8: tgaFormat := tfBGRA8;
  6457. end;
  6458. end;
  6459. if (tgaFormat = tfEmpty) then
  6460. raise EglBitmap.Create('LoadTga - unsupported format');
  6461. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6462. PixelSize := FormatDesc.GetSize(1, 1);
  6463. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6464. GetMem(ImageData, LineSize * Header.Height);
  6465. try
  6466. //column direction
  6467. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6468. Counter.X.low := Header.Height-1;;
  6469. Counter.X.high := 0;
  6470. Counter.X.dir := -1;
  6471. end else begin
  6472. Counter.X.low := 0;
  6473. Counter.X.high := Header.Height-1;
  6474. Counter.X.dir := 1;
  6475. end;
  6476. // Row direction
  6477. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6478. Counter.Y.low := 0;
  6479. Counter.Y.high := Header.Height-1;
  6480. Counter.Y.dir := 1;
  6481. end else begin
  6482. Counter.Y.low := Header.Height-1;;
  6483. Counter.Y.high := 0;
  6484. Counter.Y.dir := -1;
  6485. end;
  6486. // Read Image
  6487. case Header.ImageType of
  6488. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6489. ReadUncompressed;
  6490. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6491. ReadCompressed;
  6492. end;
  6493. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6494. result := true;
  6495. except
  6496. if Assigned(ImageData) then
  6497. FreeMem(ImageData);
  6498. raise;
  6499. end;
  6500. finally
  6501. aStream.Position := StartPosition;
  6502. end;
  6503. end
  6504. else aStream.Position := StartPosition;
  6505. end;
  6506. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6507. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6508. var
  6509. Header: TTGAHeader;
  6510. LineSize, Size, x, y: Integer;
  6511. Pixel: TglBitmapPixelData;
  6512. LineBuf, SourceData, DestData: PByte;
  6513. SourceMD, DestMD: Pointer;
  6514. FormatDesc: TFormatDescriptor;
  6515. Converter: TFormatDescriptor;
  6516. begin
  6517. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6518. raise EglBitmapUnsupportedFormat.Create(Format);
  6519. //prepare header
  6520. FillChar(Header{%H-}, SizeOf(Header), 0);
  6521. //set ImageType
  6522. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6523. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6524. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6525. else
  6526. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6527. //set BitsPerPixel
  6528. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6529. Header.Bpp := 8
  6530. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6531. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6532. Header.Bpp := 16
  6533. else if (Format in [tfBGR8, tfRGB8]) then
  6534. Header.Bpp := 24
  6535. else
  6536. Header.Bpp := 32;
  6537. //set AlphaBitCount
  6538. case Format of
  6539. tfRGB5A1, tfBGR5A1:
  6540. Header.ImageDesc := 1 and $F;
  6541. tfRGB10A2, tfBGR10A2:
  6542. Header.ImageDesc := 2 and $F;
  6543. tfRGBA4, tfBGRA4:
  6544. Header.ImageDesc := 4 and $F;
  6545. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6546. Header.ImageDesc := 8 and $F;
  6547. end;
  6548. Header.Width := Width;
  6549. Header.Height := Height;
  6550. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6551. aStream.Write(Header, SizeOf(Header));
  6552. // convert RGB(A) to BGR(A)
  6553. Converter := nil;
  6554. FormatDesc := TFormatDescriptor.Get(Format);
  6555. Size := FormatDesc.GetSize(Dimension);
  6556. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6557. if (FormatDesc.RGBInverted = tfEmpty) then
  6558. raise EglBitmap.Create('inverted RGB format is empty');
  6559. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6560. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6561. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6562. raise EglBitmap.Create('invalid inverted RGB format');
  6563. end;
  6564. if Assigned(Converter) then begin
  6565. LineSize := FormatDesc.GetSize(Width, 1);
  6566. GetMem(LineBuf, LineSize);
  6567. SourceMD := FormatDesc.CreateMappingData;
  6568. DestMD := Converter.CreateMappingData;
  6569. try
  6570. SourceData := Data;
  6571. for y := 0 to Height-1 do begin
  6572. DestData := LineBuf;
  6573. for x := 0 to Width-1 do begin
  6574. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6575. Converter.Map(Pixel, DestData, DestMD);
  6576. end;
  6577. aStream.Write(LineBuf^, LineSize);
  6578. end;
  6579. finally
  6580. FreeMem(LineBuf);
  6581. FormatDesc.FreeMappingData(SourceMD);
  6582. FormatDesc.FreeMappingData(DestMD);
  6583. end;
  6584. end else
  6585. aStream.Write(Data^, Size);
  6586. end;
  6587. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6588. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6589. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6590. const
  6591. DDS_MAGIC: Cardinal = $20534444;
  6592. // DDS_header.dwFlags
  6593. DDSD_CAPS = $00000001;
  6594. DDSD_HEIGHT = $00000002;
  6595. DDSD_WIDTH = $00000004;
  6596. DDSD_PIXELFORMAT = $00001000;
  6597. // DDS_header.sPixelFormat.dwFlags
  6598. DDPF_ALPHAPIXELS = $00000001;
  6599. DDPF_ALPHA = $00000002;
  6600. DDPF_FOURCC = $00000004;
  6601. DDPF_RGB = $00000040;
  6602. DDPF_LUMINANCE = $00020000;
  6603. // DDS_header.sCaps.dwCaps1
  6604. DDSCAPS_TEXTURE = $00001000;
  6605. // DDS_header.sCaps.dwCaps2
  6606. DDSCAPS2_CUBEMAP = $00000200;
  6607. D3DFMT_DXT1 = $31545844;
  6608. D3DFMT_DXT3 = $33545844;
  6609. D3DFMT_DXT5 = $35545844;
  6610. type
  6611. TDDSPixelFormat = packed record
  6612. dwSize: Cardinal;
  6613. dwFlags: Cardinal;
  6614. dwFourCC: Cardinal;
  6615. dwRGBBitCount: Cardinal;
  6616. dwRBitMask: Cardinal;
  6617. dwGBitMask: Cardinal;
  6618. dwBBitMask: Cardinal;
  6619. dwABitMask: Cardinal;
  6620. end;
  6621. TDDSCaps = packed record
  6622. dwCaps1: Cardinal;
  6623. dwCaps2: Cardinal;
  6624. dwDDSX: Cardinal;
  6625. dwReserved: Cardinal;
  6626. end;
  6627. TDDSHeader = packed record
  6628. dwSize: Cardinal;
  6629. dwFlags: Cardinal;
  6630. dwHeight: Cardinal;
  6631. dwWidth: Cardinal;
  6632. dwPitchOrLinearSize: Cardinal;
  6633. dwDepth: Cardinal;
  6634. dwMipMapCount: Cardinal;
  6635. dwReserved: array[0..10] of Cardinal;
  6636. PixelFormat: TDDSPixelFormat;
  6637. Caps: TDDSCaps;
  6638. dwReserved2: Cardinal;
  6639. end;
  6640. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6641. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6642. var
  6643. Header: TDDSHeader;
  6644. Converter: TbmpBitfieldFormat;
  6645. function GetDDSFormat: TglBitmapFormat;
  6646. var
  6647. fd: TFormatDescriptor;
  6648. i: Integer;
  6649. Range: TglBitmapColorRec;
  6650. match: Boolean;
  6651. begin
  6652. result := tfEmpty;
  6653. with Header.PixelFormat do begin
  6654. // Compresses
  6655. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6656. case Header.PixelFormat.dwFourCC of
  6657. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6658. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6659. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6660. end;
  6661. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6662. //find matching format
  6663. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6664. fd := TFormatDescriptor.Get(result);
  6665. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6666. (8 * fd.PixelSize = dwRGBBitCount) then
  6667. exit;
  6668. end;
  6669. //find format with same Range
  6670. Range.r := dwRBitMask;
  6671. Range.g := dwGBitMask;
  6672. Range.b := dwBBitMask;
  6673. Range.a := dwABitMask;
  6674. for i := 0 to 3 do begin
  6675. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6676. Range.arr[i] := Range.arr[i] shr 1;
  6677. end;
  6678. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6679. fd := TFormatDescriptor.Get(result);
  6680. match := true;
  6681. for i := 0 to 3 do
  6682. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6683. match := false;
  6684. break;
  6685. end;
  6686. if match then
  6687. break;
  6688. end;
  6689. //no format with same range found -> use default
  6690. if (result = tfEmpty) then begin
  6691. if (dwABitMask > 0) then
  6692. result := tfBGRA8
  6693. else
  6694. result := tfBGR8;
  6695. end;
  6696. Converter := TbmpBitfieldFormat.Create;
  6697. Converter.RedMask := dwRBitMask;
  6698. Converter.GreenMask := dwGBitMask;
  6699. Converter.BlueMask := dwBBitMask;
  6700. Converter.AlphaMask := dwABitMask;
  6701. Converter.PixelSize := dwRGBBitCount / 8;
  6702. end;
  6703. end;
  6704. end;
  6705. var
  6706. StreamPos: Int64;
  6707. x, y, LineSize, RowSize, Magic: Cardinal;
  6708. NewImage, TmpData, RowData, SrcData: System.PByte;
  6709. SourceMD, DestMD: Pointer;
  6710. Pixel: TglBitmapPixelData;
  6711. ddsFormat: TglBitmapFormat;
  6712. FormatDesc: TFormatDescriptor;
  6713. begin
  6714. result := false;
  6715. Converter := nil;
  6716. StreamPos := aStream.Position;
  6717. // Magic
  6718. aStream.Read(Magic{%H-}, sizeof(Magic));
  6719. if (Magic <> DDS_MAGIC) then begin
  6720. aStream.Position := StreamPos;
  6721. exit;
  6722. end;
  6723. //Header
  6724. aStream.Read(Header{%H-}, sizeof(Header));
  6725. if (Header.dwSize <> SizeOf(Header)) or
  6726. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6727. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6728. begin
  6729. aStream.Position := StreamPos;
  6730. exit;
  6731. end;
  6732. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6733. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  6734. ddsFormat := GetDDSFormat;
  6735. try
  6736. if (ddsFormat = tfEmpty) then
  6737. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6738. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6739. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6740. GetMem(NewImage, Header.dwHeight * LineSize);
  6741. try
  6742. TmpData := NewImage;
  6743. //Converter needed
  6744. if Assigned(Converter) then begin
  6745. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6746. GetMem(RowData, RowSize);
  6747. SourceMD := Converter.CreateMappingData;
  6748. DestMD := FormatDesc.CreateMappingData;
  6749. try
  6750. for y := 0 to Header.dwHeight-1 do begin
  6751. TmpData := NewImage;
  6752. inc(TmpData, y * LineSize);
  6753. SrcData := RowData;
  6754. aStream.Read(SrcData^, RowSize);
  6755. for x := 0 to Header.dwWidth-1 do begin
  6756. Converter.Unmap(SrcData, Pixel, SourceMD);
  6757. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6758. FormatDesc.Map(Pixel, TmpData, DestMD);
  6759. end;
  6760. end;
  6761. finally
  6762. Converter.FreeMappingData(SourceMD);
  6763. FormatDesc.FreeMappingData(DestMD);
  6764. FreeMem(RowData);
  6765. end;
  6766. end else
  6767. // Compressed
  6768. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6769. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6770. for Y := 0 to Header.dwHeight-1 do begin
  6771. aStream.Read(TmpData^, RowSize);
  6772. Inc(TmpData, LineSize);
  6773. end;
  6774. end else
  6775. // Uncompressed
  6776. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6777. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6778. for Y := 0 to Header.dwHeight-1 do begin
  6779. aStream.Read(TmpData^, RowSize);
  6780. Inc(TmpData, LineSize);
  6781. end;
  6782. end else
  6783. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6784. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  6785. result := true;
  6786. except
  6787. if Assigned(NewImage) then
  6788. FreeMem(NewImage);
  6789. raise;
  6790. end;
  6791. finally
  6792. FreeAndNil(Converter);
  6793. end;
  6794. end;
  6795. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6796. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6797. var
  6798. Header: TDDSHeader;
  6799. FormatDesc: TFormatDescriptor;
  6800. begin
  6801. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6802. raise EglBitmapUnsupportedFormat.Create(Format);
  6803. FormatDesc := TFormatDescriptor.Get(Format);
  6804. // Generell
  6805. FillChar(Header{%H-}, SizeOf(Header), 0);
  6806. Header.dwSize := SizeOf(Header);
  6807. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6808. Header.dwWidth := Max(1, Width);
  6809. Header.dwHeight := Max(1, Height);
  6810. // Caps
  6811. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6812. // Pixelformat
  6813. Header.PixelFormat.dwSize := sizeof(Header);
  6814. if (FormatDesc.IsCompressed) then begin
  6815. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6816. case Format of
  6817. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6818. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6819. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6820. end;
  6821. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6822. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6823. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6824. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6825. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6826. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6827. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6828. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6829. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6830. end else begin
  6831. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6832. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6833. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6834. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6835. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6836. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6837. end;
  6838. if (FormatDesc.HasAlpha) then
  6839. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6840. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6841. aStream.Write(Header, SizeOf(Header));
  6842. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6843. end;
  6844. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6845. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6846. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6847. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6848. const aWidth: Integer; const aHeight: Integer);
  6849. var
  6850. pTemp: pByte;
  6851. Size: Integer;
  6852. begin
  6853. if (aHeight > 1) then begin
  6854. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  6855. GetMem(pTemp, Size);
  6856. try
  6857. Move(aData^, pTemp^, Size);
  6858. FreeMem(aData);
  6859. aData := nil;
  6860. except
  6861. FreeMem(pTemp);
  6862. raise;
  6863. end;
  6864. end else
  6865. pTemp := aData;
  6866. inherited SetDataPointer(pTemp, aFormat, aWidth);
  6867. end;
  6868. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6869. function TglBitmap1D.FlipHorz: Boolean;
  6870. var
  6871. Col: Integer;
  6872. pTempDest, pDest, pSource: PByte;
  6873. begin
  6874. result := inherited FlipHorz;
  6875. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  6876. pSource := Data;
  6877. GetMem(pDest, fRowSize);
  6878. try
  6879. pTempDest := pDest;
  6880. Inc(pTempDest, fRowSize);
  6881. for Col := 0 to Width-1 do begin
  6882. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  6883. Move(pSource^, pTempDest^, fPixelSize);
  6884. Inc(pSource, fPixelSize);
  6885. end;
  6886. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  6887. result := true;
  6888. except
  6889. if Assigned(pDest) then
  6890. FreeMem(pDest);
  6891. raise;
  6892. end;
  6893. end;
  6894. end;
  6895. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6896. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  6897. var
  6898. FormatDesc: TFormatDescriptor;
  6899. begin
  6900. // Upload data
  6901. FormatDesc := TFormatDescriptor.Get(Format);
  6902. if FormatDesc.IsCompressed then begin
  6903. if not Assigned(glCompressedTexImage1D) then
  6904. raise EglBitmap.Create('compressed formats not supported by video adapter');
  6905. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  6906. end else if aBuildWithGlu then
  6907. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6908. else
  6909. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6910. // Free Data
  6911. if (FreeDataAfterGenTexture) then
  6912. FreeData;
  6913. end;
  6914. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6915. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  6916. var
  6917. BuildWithGlu, TexRec: Boolean;
  6918. TexSize: Integer;
  6919. begin
  6920. if Assigned(Data) then begin
  6921. // Check Texture Size
  6922. if (aTestTextureSize) then begin
  6923. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6924. if (Width > TexSize) then
  6925. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6926. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6927. (Target = GL_TEXTURE_RECTANGLE);
  6928. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6929. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6930. end;
  6931. CreateId;
  6932. SetupParameters(BuildWithGlu);
  6933. UploadData(BuildWithGlu);
  6934. glAreTexturesResident(1, @fID, @fIsResident);
  6935. end;
  6936. end;
  6937. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6938. procedure TglBitmap1D.AfterConstruction;
  6939. begin
  6940. inherited;
  6941. Target := GL_TEXTURE_1D;
  6942. end;
  6943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6944. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6945. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6946. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6947. begin
  6948. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6949. result := fLines[aIndex]
  6950. else
  6951. result := nil;
  6952. end;
  6953. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6954. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6955. const aWidth: Integer; const aHeight: Integer);
  6956. var
  6957. Idx, LineWidth: Integer;
  6958. begin
  6959. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6960. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6961. // Assigning Data
  6962. if Assigned(Data) then begin
  6963. SetLength(fLines, GetHeight);
  6964. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6965. for Idx := 0 to GetHeight-1 do begin
  6966. fLines[Idx] := Data;
  6967. Inc(fLines[Idx], Idx * LineWidth);
  6968. end;
  6969. end
  6970. else SetLength(fLines, 0);
  6971. end else begin
  6972. SetLength(fLines, 0);
  6973. end;
  6974. end;
  6975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6976. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  6977. var
  6978. FormatDesc: TFormatDescriptor;
  6979. begin
  6980. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6981. FormatDesc := TFormatDescriptor.Get(Format);
  6982. if FormatDesc.IsCompressed then begin
  6983. if not Assigned(glCompressedTexImage2D) then
  6984. raise EglBitmap.Create('compressed formats not supported by video adapter');
  6985. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  6986. end else if aBuildWithGlu then begin
  6987. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  6988. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6989. end else begin
  6990. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  6991. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6992. end;
  6993. // Freigeben
  6994. if (FreeDataAfterGenTexture) then
  6995. FreeData;
  6996. end;
  6997. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6998. procedure TglBitmap2D.AfterConstruction;
  6999. begin
  7000. inherited;
  7001. Target := GL_TEXTURE_2D;
  7002. end;
  7003. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7004. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  7005. var
  7006. Temp: pByte;
  7007. Size, w, h: Integer;
  7008. FormatDesc: TFormatDescriptor;
  7009. begin
  7010. FormatDesc := TFormatDescriptor.Get(aFormat);
  7011. if FormatDesc.IsCompressed then
  7012. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7013. w := aRight - aLeft;
  7014. h := aBottom - aTop;
  7015. Size := FormatDesc.GetSize(w, h);
  7016. GetMem(Temp, Size);
  7017. try
  7018. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7019. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7020. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  7021. FlipVert;
  7022. except
  7023. if Assigned(Temp) then
  7024. FreeMem(Temp);
  7025. raise;
  7026. end;
  7027. end;
  7028. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7029. procedure TglBitmap2D.GetDataFromTexture;
  7030. var
  7031. Temp: PByte;
  7032. TempWidth, TempHeight: Integer;
  7033. TempIntFormat: Cardinal;
  7034. IntFormat, f: TglBitmapFormat;
  7035. FormatDesc: TFormatDescriptor;
  7036. begin
  7037. Bind;
  7038. // Request Data
  7039. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7040. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7041. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7042. IntFormat := tfEmpty;
  7043. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  7044. FormatDesc := TFormatDescriptor.Get(f);
  7045. if (FormatDesc.glInternalFormat = TempIntFormat) then begin
  7046. IntFormat := FormatDesc.Format;
  7047. break;
  7048. end;
  7049. end;
  7050. // Getting data from OpenGL
  7051. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7052. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7053. try
  7054. if FormatDesc.IsCompressed then begin
  7055. if not Assigned(glGetCompressedTexImage) then
  7056. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7057. glGetCompressedTexImage(Target, 0, Temp)
  7058. end else
  7059. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7060. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7061. except
  7062. if Assigned(Temp) then
  7063. FreeMem(Temp);
  7064. raise;
  7065. end;
  7066. end;
  7067. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7068. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7069. var
  7070. BuildWithGlu, PotTex, TexRec: Boolean;
  7071. TexSize: Integer;
  7072. begin
  7073. if Assigned(Data) then begin
  7074. // Check Texture Size
  7075. if (aTestTextureSize) then begin
  7076. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7077. if ((Height > TexSize) or (Width > TexSize)) then
  7078. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7079. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7080. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7081. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7082. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7083. end;
  7084. CreateId;
  7085. SetupParameters(BuildWithGlu);
  7086. UploadData(Target, BuildWithGlu);
  7087. glAreTexturesResident(1, @fID, @fIsResident);
  7088. end;
  7089. end;
  7090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7091. function TglBitmap2D.FlipHorz: Boolean;
  7092. var
  7093. Col, Row: Integer;
  7094. TempDestData, DestData, SourceData: PByte;
  7095. ImgSize: Integer;
  7096. begin
  7097. result := inherited FlipHorz;
  7098. if Assigned(Data) then begin
  7099. SourceData := Data;
  7100. ImgSize := Height * fRowSize;
  7101. GetMem(DestData, ImgSize);
  7102. try
  7103. TempDestData := DestData;
  7104. Dec(TempDestData, fRowSize + fPixelSize);
  7105. for Row := 0 to Height -1 do begin
  7106. Inc(TempDestData, fRowSize * 2);
  7107. for Col := 0 to Width -1 do begin
  7108. Move(SourceData^, TempDestData^, fPixelSize);
  7109. Inc(SourceData, fPixelSize);
  7110. Dec(TempDestData, fPixelSize);
  7111. end;
  7112. end;
  7113. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  7114. result := true;
  7115. except
  7116. if Assigned(DestData) then
  7117. FreeMem(DestData);
  7118. raise;
  7119. end;
  7120. end;
  7121. end;
  7122. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7123. function TglBitmap2D.FlipVert: Boolean;
  7124. var
  7125. Row: Integer;
  7126. TempDestData, DestData, SourceData: PByte;
  7127. begin
  7128. result := inherited FlipVert;
  7129. if Assigned(Data) then begin
  7130. SourceData := Data;
  7131. GetMem(DestData, Height * fRowSize);
  7132. try
  7133. TempDestData := DestData;
  7134. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7135. for Row := 0 to Height -1 do begin
  7136. Move(SourceData^, TempDestData^, fRowSize);
  7137. Dec(TempDestData, fRowSize);
  7138. Inc(SourceData, fRowSize);
  7139. end;
  7140. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  7141. result := true;
  7142. except
  7143. if Assigned(DestData) then
  7144. FreeMem(DestData);
  7145. raise;
  7146. end;
  7147. end;
  7148. end;
  7149. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7150. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7151. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7152. type
  7153. TMatrixItem = record
  7154. X, Y: Integer;
  7155. W: Single;
  7156. end;
  7157. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7158. TglBitmapToNormalMapRec = Record
  7159. Scale: Single;
  7160. Heights: array of Single;
  7161. MatrixU : array of TMatrixItem;
  7162. MatrixV : array of TMatrixItem;
  7163. end;
  7164. const
  7165. ONE_OVER_255 = 1 / 255;
  7166. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7167. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7168. var
  7169. Val: Single;
  7170. begin
  7171. with FuncRec do begin
  7172. Val :=
  7173. Source.Data.r * LUMINANCE_WEIGHT_R +
  7174. Source.Data.g * LUMINANCE_WEIGHT_G +
  7175. Source.Data.b * LUMINANCE_WEIGHT_B;
  7176. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7177. end;
  7178. end;
  7179. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7180. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7181. begin
  7182. with FuncRec do
  7183. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7184. end;
  7185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7186. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7187. type
  7188. TVec = Array[0..2] of Single;
  7189. var
  7190. Idx: Integer;
  7191. du, dv: Double;
  7192. Len: Single;
  7193. Vec: TVec;
  7194. function GetHeight(X, Y: Integer): Single;
  7195. begin
  7196. with FuncRec do begin
  7197. X := Max(0, Min(Size.X -1, X));
  7198. Y := Max(0, Min(Size.Y -1, Y));
  7199. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7200. end;
  7201. end;
  7202. begin
  7203. with FuncRec do begin
  7204. with PglBitmapToNormalMapRec(Args)^ do begin
  7205. du := 0;
  7206. for Idx := Low(MatrixU) to High(MatrixU) do
  7207. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7208. dv := 0;
  7209. for Idx := Low(MatrixU) to High(MatrixU) do
  7210. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7211. Vec[0] := -du * Scale;
  7212. Vec[1] := -dv * Scale;
  7213. Vec[2] := 1;
  7214. end;
  7215. // Normalize
  7216. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7217. if Len <> 0 then begin
  7218. Vec[0] := Vec[0] * Len;
  7219. Vec[1] := Vec[1] * Len;
  7220. Vec[2] := Vec[2] * Len;
  7221. end;
  7222. // Farbe zuweisem
  7223. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7224. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7225. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7226. end;
  7227. end;
  7228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7229. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7230. var
  7231. Rec: TglBitmapToNormalMapRec;
  7232. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7233. begin
  7234. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7235. Matrix[Index].X := X;
  7236. Matrix[Index].Y := Y;
  7237. Matrix[Index].W := W;
  7238. end;
  7239. end;
  7240. begin
  7241. if TFormatDescriptor.Get(Format).IsCompressed then
  7242. raise EglBitmapUnsupportedFormat.Create(Format);
  7243. if aScale > 100 then
  7244. Rec.Scale := 100
  7245. else if aScale < -100 then
  7246. Rec.Scale := -100
  7247. else
  7248. Rec.Scale := aScale;
  7249. SetLength(Rec.Heights, Width * Height);
  7250. try
  7251. case aFunc of
  7252. nm4Samples: begin
  7253. SetLength(Rec.MatrixU, 2);
  7254. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7255. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7256. SetLength(Rec.MatrixV, 2);
  7257. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7258. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7259. end;
  7260. nmSobel: begin
  7261. SetLength(Rec.MatrixU, 6);
  7262. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7263. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7264. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7265. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7266. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7267. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7268. SetLength(Rec.MatrixV, 6);
  7269. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7270. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7271. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7272. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7273. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7274. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7275. end;
  7276. nm3x3: begin
  7277. SetLength(Rec.MatrixU, 6);
  7278. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7279. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7280. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7281. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7282. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7283. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7284. SetLength(Rec.MatrixV, 6);
  7285. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7286. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7287. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7288. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7289. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7290. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7291. end;
  7292. nm5x5: begin
  7293. SetLength(Rec.MatrixU, 20);
  7294. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7295. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7296. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7297. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7298. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7299. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7300. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7301. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7302. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7303. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7304. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7305. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7306. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7307. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7308. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7309. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7310. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7311. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7312. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7313. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7314. SetLength(Rec.MatrixV, 20);
  7315. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7316. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7317. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7318. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7319. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7320. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7321. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7322. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7323. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7324. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7325. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7326. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7327. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7328. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7329. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7330. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7331. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7332. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7333. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7334. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7335. end;
  7336. end;
  7337. // Daten Sammeln
  7338. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7339. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7340. else
  7341. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7342. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7343. finally
  7344. SetLength(Rec.Heights, 0);
  7345. end;
  7346. end;
  7347. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7348. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7349. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7350. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7351. begin
  7352. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7353. end;
  7354. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7355. procedure TglBitmapCubeMap.AfterConstruction;
  7356. begin
  7357. inherited;
  7358. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7359. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7360. SetWrap;
  7361. Target := GL_TEXTURE_CUBE_MAP;
  7362. fGenMode := GL_REFLECTION_MAP;
  7363. end;
  7364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7365. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7366. var
  7367. BuildWithGlu: Boolean;
  7368. TexSize: Integer;
  7369. begin
  7370. if (aTestTextureSize) then begin
  7371. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7372. if (Height > TexSize) or (Width > TexSize) then
  7373. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7374. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7375. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7376. end;
  7377. if (ID = 0) then
  7378. CreateID;
  7379. SetupParameters(BuildWithGlu);
  7380. UploadData(aCubeTarget, BuildWithGlu);
  7381. end;
  7382. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7383. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
  7384. begin
  7385. inherited Bind (aEnableTextureUnit);
  7386. if aEnableTexCoordsGen then begin
  7387. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7388. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7389. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7390. glEnable(GL_TEXTURE_GEN_S);
  7391. glEnable(GL_TEXTURE_GEN_T);
  7392. glEnable(GL_TEXTURE_GEN_R);
  7393. end;
  7394. end;
  7395. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7396. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
  7397. begin
  7398. inherited Unbind(aDisableTextureUnit);
  7399. if aDisableTexCoordsGen then begin
  7400. glDisable(GL_TEXTURE_GEN_S);
  7401. glDisable(GL_TEXTURE_GEN_T);
  7402. glDisable(GL_TEXTURE_GEN_R);
  7403. end;
  7404. end;
  7405. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7406. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7407. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7408. type
  7409. TVec = Array[0..2] of Single;
  7410. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7411. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7412. TglBitmapNormalMapRec = record
  7413. HalfSize : Integer;
  7414. Func: TglBitmapNormalMapGetVectorFunc;
  7415. end;
  7416. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7417. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7418. begin
  7419. aVec[0] := aHalfSize;
  7420. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7421. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7422. end;
  7423. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7424. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7425. begin
  7426. aVec[0] := - aHalfSize;
  7427. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7428. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7429. end;
  7430. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7431. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7432. begin
  7433. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7434. aVec[1] := aHalfSize;
  7435. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7436. end;
  7437. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7438. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7439. begin
  7440. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7441. aVec[1] := - aHalfSize;
  7442. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7443. end;
  7444. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7445. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7446. begin
  7447. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7448. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7449. aVec[2] := aHalfSize;
  7450. end;
  7451. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7452. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7453. begin
  7454. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7455. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7456. aVec[2] := - aHalfSize;
  7457. end;
  7458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7459. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7460. var
  7461. i: Integer;
  7462. Vec: TVec;
  7463. Len: Single;
  7464. begin
  7465. with FuncRec do begin
  7466. with PglBitmapNormalMapRec(Args)^ do begin
  7467. Func(Vec, Position, HalfSize);
  7468. // Normalize
  7469. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7470. if Len <> 0 then begin
  7471. Vec[0] := Vec[0] * Len;
  7472. Vec[1] := Vec[1] * Len;
  7473. Vec[2] := Vec[2] * Len;
  7474. end;
  7475. // Scale Vector and AddVectro
  7476. Vec[0] := Vec[0] * 0.5 + 0.5;
  7477. Vec[1] := Vec[1] * 0.5 + 0.5;
  7478. Vec[2] := Vec[2] * 0.5 + 0.5;
  7479. end;
  7480. // Set Color
  7481. for i := 0 to 2 do
  7482. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7483. end;
  7484. end;
  7485. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7486. procedure TglBitmapNormalMap.AfterConstruction;
  7487. begin
  7488. inherited;
  7489. fGenMode := GL_NORMAL_MAP;
  7490. end;
  7491. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7492. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7493. var
  7494. Rec: TglBitmapNormalMapRec;
  7495. SizeRec: TglBitmapPixelPosition;
  7496. begin
  7497. Rec.HalfSize := aSize div 2;
  7498. FreeDataAfterGenTexture := false;
  7499. SizeRec.Fields := [ffX, ffY];
  7500. SizeRec.X := aSize;
  7501. SizeRec.Y := aSize;
  7502. // Positive X
  7503. Rec.Func := glBitmapNormalMapPosX;
  7504. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7505. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7506. // Negative X
  7507. Rec.Func := glBitmapNormalMapNegX;
  7508. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7509. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7510. // Positive Y
  7511. Rec.Func := glBitmapNormalMapPosY;
  7512. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7513. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7514. // Negative Y
  7515. Rec.Func := glBitmapNormalMapNegY;
  7516. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7517. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7518. // Positive Z
  7519. Rec.Func := glBitmapNormalMapPosZ;
  7520. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7521. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7522. // Negative Z
  7523. Rec.Func := glBitmapNormalMapNegZ;
  7524. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7525. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7526. end;
  7527. initialization
  7528. glBitmapSetDefaultFormat (tfEmpty);
  7529. glBitmapSetDefaultMipmap (mmMipmap);
  7530. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7531. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7532. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7533. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7534. glBitmapSetDefaultDeleteTextureOnFree (true);
  7535. TFormatDescriptor.Init;
  7536. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7537. OpenGLInitialized := false;
  7538. InitOpenGLCS := TCriticalSection.Create;
  7539. {$ENDIF}
  7540. finalization
  7541. TFormatDescriptor.Finalize;
  7542. {$IFDEF GLB_NATIVE_OGL}
  7543. if Assigned(GL_LibHandle) then
  7544. glbFreeLibrary(GL_LibHandle);
  7545. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7546. if Assigned(GLU_LibHandle) then
  7547. glbFreeLibrary(GLU_LibHandle);
  7548. FreeAndNil(InitOpenGLCS);
  7549. {$ENDIF}
  7550. {$ENDIF}
  7551. end.