25'ten fazla konu seçemezsiniz Konular bir harf veya rakamla başlamalı, kısa çizgiler ('-') içerebilir ve en fazla 35 karakter uzunluğunda olabilir.

8661 satır
299 KiB

  1. {***********************************************************
  2. glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  3. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  4. modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
  5. ------------------------------------------------------------
  6. The contents of this file are used with permission, subject to
  7. the Mozilla Public License Version 1.1 (the "License"); you may
  8. not use this file except in compliance with the License. You may
  9. obtain a copy of the License at
  10. http://www.mozilla.org/MPL/MPL-1.1.html
  11. ------------------------------------------------------------
  12. Version 3.0.1
  13. ------------------------------------------------------------
  14. History
  15. 20-11-2013
  16. - refactoring of the complete library
  17. 21-03-2010
  18. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  19. then it's your problem if that isn't true. This prevents the unit for incompatibility
  20. with newer versions of Delphi.
  21. - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  22. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  23. 10-08-2008
  24. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  25. - Additional Datapointer for functioninterface now has the name CustomData
  26. 24-07-2008
  27. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  28. - If you load an texture from an file the property Filename will be set to the name of the file
  29. - Three new properties to attach custom data to the Texture objects
  30. - CustomName (free for use string)
  31. - CustomNameW (free for use widestring)
  32. - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  33. 27-05-2008
  34. - RLE TGAs loaded much faster
  35. 26-05-2008
  36. - fixed some problem with reading RLE TGAs.
  37. 21-05-2008
  38. - function clone now only copys data if it's assigned and now it also copies the ID
  39. - it seems that lazarus dont like comments in comments.
  40. 01-05-2008
  41. - It's possible to set the id of the texture
  42. - define GLB_NO_NATIVE_GL deactivated by default
  43. 27-04-2008
  44. - Now supports the following libraries
  45. - SDL and SDL_image
  46. - libPNG
  47. - libJPEG
  48. - Linux compatibillity via free pascal compatibility (delphi sources optional)
  49. - BMPs now loaded manuel
  50. - Large restructuring
  51. - Property DataPtr now has the name Data
  52. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  53. - Unused Depth removed
  54. - Function FreeData to freeing image data added
  55. 24-10-2007
  56. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  57. 15-11-2006
  58. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  59. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  60. - Function ReadOpenGLExtension is now only intern
  61. 29-06-2006
  62. - pngimage now disabled by default like all other versions.
  63. 26-06-2006
  64. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  65. 22-06-2006
  66. - Fixed some Problem with Delphi 5
  67. - Now uses the newest version of pngimage. Makes saving pngs much easier.
  68. 22-03-2006
  69. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  70. 09-03-2006
  71. - Internal Format ifDepth8 added
  72. - function GrabScreen now supports all uncompressed formats
  73. 31-01-2006
  74. - AddAlphaFromglBitmap implemented
  75. 29-12-2005
  76. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  77. 28-12-2005
  78. - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  79. property Width, Height, Depth are still existing and new property Dimension are avail
  80. 11-12-2005
  81. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  82. 19-10-2005
  83. - Added function GrabScreen to class TglBitmap2D
  84. 18-10-2005
  85. - Added support to Save images
  86. - Added function Clone to Clone Instance
  87. 11-10-2005
  88. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  89. Usefull for Future
  90. - Several speed optimizations
  91. 09-10-2005
  92. - Internal structure change. Loading of TGA, PNG and DDS improved.
  93. Data, format and size will now set directly with SetDataPtr.
  94. - AddFunc now works with all Types of Images and Formats
  95. - Some Funtions moved to Baseclass TglBitmap
  96. 06-10-2005
  97. - Added Support to decompress DXT3 and DXT5 compressed Images.
  98. - Added Mapping to convert data from one format into an other.
  99. 05-10-2005
  100. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  101. supported Input format (supported by GetPixel) into any uncompresed Format
  102. - Added Support to decompress DXT1 compressed Images.
  103. - SwapColors replaced by ConvertTo
  104. 04-10-2005
  105. - Added Support for compressed DDSs
  106. - Added new internal formats (DXT1, DXT3, DXT5)
  107. 29-09-2005
  108. - Parameter Components renamed to InternalFormat
  109. 23-09-2005
  110. - Some AllocMem replaced with GetMem (little speed change)
  111. - better exception handling. Better protection from memory leaks.
  112. 22-09-2005
  113. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
  114. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
  115. 07-09-2005
  116. - Added support for Grayscale textures
  117. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
  118. 10-07-2005
  119. - Added support for GL_VERSION_2_0
  120. - Added support for GL_EXT_texture_filter_anisotropic
  121. 04-07-2005
  122. - Function FillWithColor fills the Image with one Color
  123. - Function LoadNormalMap added
  124. 30-06-2005
  125. - ToNormalMap allows to Create an NormalMap from the Alphachannel
  126. - ToNormalMap now supports Sobel (nmSobel) function.
  127. 29-06-2005
  128. - support for RLE Compressed RGB TGAs added
  129. 28-06-2005
  130. - Class TglBitmapNormalMap added to support Normalmap generation
  131. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
  132. 3 Filters are supported. (4 Samples, 3x3 and 5x5)
  133. 16-06-2005
  134. - Method LoadCubeMapClass removed
  135. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
  136. - virtual abstract method GenTexture in class TglBitmap now is protected
  137. 12-06-2005
  138. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
  139. 10-06-2005
  140. - little enhancement for IsPowerOfTwo
  141. - TglBitmap1D.GenTexture now tests NPOT Textures
  142. 06-06-2005
  143. - some little name changes. All properties or function with Texture in name are
  144. now without texture in name. We have allways texture so we dosn't name it.
  145. 03-06-2005
  146. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
  147. TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
  148. 02-06-2005
  149. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
  150. 25-04-2005
  151. - Function Unbind added
  152. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
  153. 21-04-2005
  154. - class TglBitmapCubeMap added (allows to Create Cubemaps)
  155. 29-03-2005
  156. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
  157. To Enable png's use the define pngimage
  158. 22-03-2005
  159. - New Functioninterface added
  160. - Function GetPixel added
  161. 27-11-2004
  162. - Property BuildMipMaps renamed to MipMap
  163. 21-11-2004
  164. - property Name removed.
  165. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
  166. 22-05-2004
  167. - property name added. Only used in glForms!
  168. 26-11-2003
  169. - property FreeDataAfterGenTexture is now available as default (default = true)
  170. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
  171. - function MoveMemory replaced with function Move (little speed change)
  172. - several calculations stored in variables (little speed change)
  173. 29-09-2003
  174. - property BuildMipsMaps added (default = true)
  175. if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
  176. - property FreeDataAfterGenTexture added (default = true)
  177. if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
  178. - parameter DisableOtherTextureUnits of Bind removed
  179. - parameter FreeDataAfterGeneration of GenTextures removed
  180. 12-09-2003
  181. - TglBitmap dosn't delete data if class was destroyed (fixed)
  182. 09-09-2003
  183. - Bind now enables TextureUnits (by params)
  184. - GenTextures can leave data (by param)
  185. - LoadTextures now optimal
  186. 03-09-2003
  187. - Performance optimization in AddFunc
  188. - procedure Bind moved to subclasses
  189. - Added new Class TglBitmap1D to support real OpenGL 1D Textures
  190. 19-08-2003
  191. - Texturefilter and texturewrap now also as defaults
  192. Minfilter = GL_LINEAR_MIPMAP_LINEAR
  193. Magfilter = GL_LINEAR
  194. Wrap(str) = GL_CLAMP_TO_EDGE
  195. - Added new format tfCompressed to create a compressed texture.
  196. - propertys IsCompressed, TextureSize and IsResident added
  197. IsCompressed and TextureSize only contains data from level 0
  198. 18-08-2003
  199. - Added function AddFunc to add PerPixelEffects to Image
  200. - LoadFromFunc now based on AddFunc
  201. - Invert now based on AddFunc
  202. - SwapColors now based on AddFunc
  203. 16-08-2003
  204. - Added function FlipHorz
  205. 15-08-2003
  206. - Added function LaodFromFunc to create images with function
  207. - Added function FlipVert
  208. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
  209. 29-07-2003
  210. - Added Alphafunctions to calculate alpha per function
  211. - Added Alpha from ColorKey using alphafunctions
  212. 28-07-2003
  213. - First full functionally Version of glBitmap
  214. - Support for 24Bit and 32Bit TGA Pictures added
  215. 25-07-2003
  216. - begin of programming
  217. ***********************************************************}
  218. unit glBitmap;
  219. // Please uncomment the defines below to configure the glBitmap to your preferences.
  220. // If you have configured the unit you can uncomment the warning above.
  221. {$MESSAGE error 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  223. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  225. // activate to enable build-in OpenGL support with statically linked methods
  226. // use dglOpenGL.pas if not enabled
  227. {.$DEFINE GLB_NATIVE_OGL_STATIC}
  228. // activate to enable build-in OpenGL support with dynamically linked methods
  229. // use dglOpenGL.pas if not enabled
  230. {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
  231. // activate to enable the support for SDL_surfaces
  232. {.$DEFINE GLB_SDL}
  233. // activate to enable the support for Delphi (including support for Delphi's (not Lazarus') TBitmap)
  234. {.$DEFINE GLB_DELPHI}
  235. // activate to enable the support for TLazIntfImage from Lazarus
  236. {.$DEFINE GLB_LAZARUS}
  237. // activate to enable the support of SDL_image to load files. (READ ONLY)
  238. // If you enable SDL_image all other libraries will be ignored!
  239. {.$DEFINE GLB_SDL_IMAGE}
  240. // activate to enable Lazarus TPortableNetworkGraphic support
  241. // if you enable this pngImage and libPNG will be ignored
  242. {.$DEFINE GLB_LAZ_PNG}
  243. // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
  244. // if you enable pngimage the libPNG will be ignored
  245. {.$DEFINE GLB_PNGIMAGE}
  246. // activate to use the libPNG -> http://www.libpng.org/
  247. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
  248. {.$DEFINE GLB_LIB_PNG}
  249. // activate to enable Lazarus TJPEGImage support
  250. // if you enable this delphi jpegs and libJPEG will be ignored
  251. {.$DEFINE GLB_LAZ_JPEG}
  252. // if you enable delphi jpegs the libJPEG will be ignored
  253. {.$DEFINE GLB_DELPHI_JPEG}
  254. // activate to use the libJPEG -> http://www.ijg.org/
  255. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
  256. {.$DEFINE GLB_LIB_JPEG}
  257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  258. // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  259. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  260. // Delphi Versions
  261. {$IFDEF fpc}
  262. {$MODE Delphi}
  263. {$IFDEF CPUI386}
  264. {$DEFINE CPU386}
  265. {$ASMMODE INTEL}
  266. {$ENDIF}
  267. {$IFNDEF WINDOWS}
  268. {$linklib c}
  269. {$ENDIF}
  270. {$ENDIF}
  271. // Operation System
  272. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  273. {$DEFINE GLB_WIN}
  274. {$ELSEIF DEFINED(LINUX)}
  275. {$DEFINE GLB_LINUX}
  276. {$IFEND}
  277. // native OpenGL Support
  278. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  279. {$DEFINE GLB_NATIVE_OGL}
  280. {$IFEND}
  281. // checking define combinations
  282. //SDL Image
  283. {$IFDEF GLB_SDL_IMAGE}
  284. {$IFNDEF GLB_SDL}
  285. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  286. {$DEFINE GLB_SDL}
  287. {$ENDIF}
  288. {$IFDEF GLB_LAZ_PNG}
  289. {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  290. {$undef GLB_LAZ_PNG}
  291. {$ENDIF}
  292. {$IFDEF GLB_PNGIMAGE}
  293. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  294. {$undef GLB_PNGIMAGE}
  295. {$ENDIF}
  296. {$IFDEF GLB_LAZ_JPEG}
  297. {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  298. {$undef GLB_LAZ_JPEG}
  299. {$ENDIF}
  300. {$IFDEF GLB_DELPHI_JPEG}
  301. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  302. {$undef GLB_DELPHI_JPEG}
  303. {$ENDIF}
  304. {$IFDEF GLB_LIB_PNG}
  305. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  306. {$undef GLB_LIB_PNG}
  307. {$ENDIF}
  308. {$IFDEF GLB_LIB_JPEG}
  309. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  310. {$undef GLB_LIB_JPEG}
  311. {$ENDIF}
  312. {$DEFINE GLB_SUPPORT_PNG_READ}
  313. {$DEFINE GLB_SUPPORT_JPEG_READ}
  314. {$ENDIF}
  315. // Lazarus TPortableNetworkGraphic
  316. {$IFDEF GLB_LAZ_PNG}
  317. {$IFNDEF GLB_LAZARUS}
  318. {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
  319. {$DEFINE GLB_LAZARUS}
  320. {$ENDIF}
  321. {$IFDEF GLB_PNGIMAGE}
  322. {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  323. {$undef GLB_PNGIMAGE}
  324. {$ENDIF}
  325. {$IFDEF GLB_LIB_PNG}
  326. {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  327. {$undef GLB_LIB_PNG}
  328. {$ENDIF}
  329. {$DEFINE GLB_SUPPORT_PNG_READ}
  330. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  331. {$ENDIF}
  332. // PNG Image
  333. {$IFDEF GLB_PNGIMAGE}
  334. {$IFDEF GLB_LIB_PNG}
  335. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  336. {$undef GLB_LIB_PNG}
  337. {$ENDIF}
  338. {$DEFINE GLB_SUPPORT_PNG_READ}
  339. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  340. {$ENDIF}
  341. // libPNG
  342. {$IFDEF GLB_LIB_PNG}
  343. {$DEFINE GLB_SUPPORT_PNG_READ}
  344. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  345. {$ENDIF}
  346. // Lazarus TJPEGImage
  347. {$IFDEF GLB_LAZ_JPEG}
  348. {$IFNDEF GLB_LAZARUS}
  349. {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
  350. {$DEFINE GLB_LAZARUS}
  351. {$ENDIF}
  352. {$IFDEF GLB_DELPHI_JPEG}
  353. {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
  354. {$undef GLB_DELPHI_JPEG}
  355. {$ENDIF}
  356. {$IFDEF GLB_LIB_JPEG}
  357. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
  358. {$undef GLB_LIB_JPEG}
  359. {$ENDIF}
  360. {$DEFINE GLB_SUPPORT_JPEG_READ}
  361. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  362. {$ENDIF}
  363. // JPEG Image
  364. {$IFDEF GLB_DELPHI_JPEG}
  365. {$IFDEF GLB_LIB_JPEG}
  366. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  367. {$undef GLB_LIB_JPEG}
  368. {$ENDIF}
  369. {$DEFINE GLB_SUPPORT_JPEG_READ}
  370. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  371. {$ENDIF}
  372. // libJPEG
  373. {$IFDEF GLB_LIB_JPEG}
  374. {$DEFINE GLB_SUPPORT_JPEG_READ}
  375. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  376. {$ENDIF}
  377. // native OpenGL
  378. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  379. {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
  380. {$IFEND}
  381. // general options
  382. {$EXTENDEDSYNTAX ON}
  383. {$LONGSTRINGS ON}
  384. {$ALIGN ON}
  385. {$IFNDEF FPC}
  386. {$OPTIMIZATION ON}
  387. {$ENDIF}
  388. interface
  389. uses
  390. {$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
  391. {$IF DEFINED(GLB_WIN) AND
  392. (DEFINED(GLB_NATIVE_OGL) OR
  393. DEFINED(GLB_DELPHI))} windows, {$IFEND}
  394. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  395. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  396. {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$ENDIF}
  397. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  398. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  399. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  400. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  401. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  402. Classes, SysUtils;
  403. {$IFDEF GLB_NATIVE_OGL}
  404. const
  405. GL_TRUE = 1;
  406. GL_FALSE = 0;
  407. GL_ZERO = 0;
  408. GL_ONE = 1;
  409. GL_VERSION = $1F02;
  410. GL_EXTENSIONS = $1F03;
  411. GL_TEXTURE_1D = $0DE0;
  412. GL_TEXTURE_2D = $0DE1;
  413. GL_TEXTURE_RECTANGLE = $84F5;
  414. GL_NORMAL_MAP = $8511;
  415. GL_TEXTURE_CUBE_MAP = $8513;
  416. GL_REFLECTION_MAP = $8512;
  417. GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
  418. GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
  419. GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
  420. GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
  421. GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
  422. GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
  423. GL_TEXTURE_WIDTH = $1000;
  424. GL_TEXTURE_HEIGHT = $1001;
  425. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  426. GL_TEXTURE_SWIZZLE_RGBA = $8E46;
  427. GL_S = $2000;
  428. GL_T = $2001;
  429. GL_R = $2002;
  430. GL_Q = $2003;
  431. GL_TEXTURE_GEN_S = $0C60;
  432. GL_TEXTURE_GEN_T = $0C61;
  433. GL_TEXTURE_GEN_R = $0C62;
  434. GL_TEXTURE_GEN_Q = $0C63;
  435. GL_RED = $1903;
  436. GL_GREEN = $1904;
  437. GL_BLUE = $1905;
  438. GL_ALPHA = $1906;
  439. GL_ALPHA4 = $803B;
  440. GL_ALPHA8 = $803C;
  441. GL_ALPHA12 = $803D;
  442. GL_ALPHA16 = $803E;
  443. GL_LUMINANCE = $1909;
  444. GL_LUMINANCE4 = $803F;
  445. GL_LUMINANCE8 = $8040;
  446. GL_LUMINANCE12 = $8041;
  447. GL_LUMINANCE16 = $8042;
  448. GL_LUMINANCE_ALPHA = $190A;
  449. GL_LUMINANCE4_ALPHA4 = $8043;
  450. GL_LUMINANCE6_ALPHA2 = $8044;
  451. GL_LUMINANCE8_ALPHA8 = $8045;
  452. GL_LUMINANCE12_ALPHA4 = $8046;
  453. GL_LUMINANCE12_ALPHA12 = $8047;
  454. GL_LUMINANCE16_ALPHA16 = $8048;
  455. GL_RGB = $1907;
  456. GL_BGR = $80E0;
  457. GL_R3_G3_B2 = $2A10;
  458. GL_RGB4 = $804F;
  459. GL_RGB5 = $8050;
  460. GL_RGB565 = $8D62;
  461. GL_RGB8 = $8051;
  462. GL_RGB10 = $8052;
  463. GL_RGB12 = $8053;
  464. GL_RGB16 = $8054;
  465. GL_RGBA = $1908;
  466. GL_BGRA = $80E1;
  467. GL_RGBA2 = $8055;
  468. GL_RGBA4 = $8056;
  469. GL_RGB5_A1 = $8057;
  470. GL_RGBA8 = $8058;
  471. GL_RGB10_A2 = $8059;
  472. GL_RGBA12 = $805A;
  473. GL_RGBA16 = $805B;
  474. GL_DEPTH_COMPONENT = $1902;
  475. GL_DEPTH_COMPONENT16 = $81A5;
  476. GL_DEPTH_COMPONENT24 = $81A6;
  477. GL_DEPTH_COMPONENT32 = $81A7;
  478. GL_COMPRESSED_RGB = $84ED;
  479. GL_COMPRESSED_RGBA = $84EE;
  480. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  481. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  482. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  483. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  484. GL_UNSIGNED_BYTE = $1401;
  485. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  486. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  487. GL_UNSIGNED_SHORT = $1403;
  488. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  489. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  490. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  491. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  492. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  493. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  494. GL_UNSIGNED_INT = $1405;
  495. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  496. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  497. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  498. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  499. { Texture Filter }
  500. GL_TEXTURE_MAG_FILTER = $2800;
  501. GL_TEXTURE_MIN_FILTER = $2801;
  502. GL_NEAREST = $2600;
  503. GL_NEAREST_MIPMAP_NEAREST = $2700;
  504. GL_NEAREST_MIPMAP_LINEAR = $2702;
  505. GL_LINEAR = $2601;
  506. GL_LINEAR_MIPMAP_NEAREST = $2701;
  507. GL_LINEAR_MIPMAP_LINEAR = $2703;
  508. { Texture Wrap }
  509. GL_TEXTURE_WRAP_S = $2802;
  510. GL_TEXTURE_WRAP_T = $2803;
  511. GL_TEXTURE_WRAP_R = $8072;
  512. GL_CLAMP = $2900;
  513. GL_REPEAT = $2901;
  514. GL_CLAMP_TO_EDGE = $812F;
  515. GL_CLAMP_TO_BORDER = $812D;
  516. GL_MIRRORED_REPEAT = $8370;
  517. { Other }
  518. GL_GENERATE_MIPMAP = $8191;
  519. GL_TEXTURE_BORDER_COLOR = $1004;
  520. GL_MAX_TEXTURE_SIZE = $0D33;
  521. GL_PACK_ALIGNMENT = $0D05;
  522. GL_UNPACK_ALIGNMENT = $0CF5;
  523. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  524. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  525. GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
  526. GL_TEXTURE_GEN_MODE = $2500;
  527. {$IF DEFINED(GLB_WIN)}
  528. libglu = 'glu32.dll';
  529. libopengl = 'opengl32.dll';
  530. {$ELSEIF DEFINED(GLB_LINUX)}
  531. libglu = 'libGLU.so.1';
  532. libopengl = 'libGL.so.1';
  533. {$IFEND}
  534. type
  535. GLboolean = BYTEBOOL;
  536. GLint = Integer;
  537. GLsizei = Integer;
  538. GLuint = Cardinal;
  539. GLfloat = Single;
  540. GLenum = Cardinal;
  541. PGLvoid = Pointer;
  542. PGLboolean = ^GLboolean;
  543. PGLint = ^GLint;
  544. PGLuint = ^GLuint;
  545. PGLfloat = ^GLfloat;
  546. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  547. TglCompressedTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  548. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  549. {$IF DEFINED(GLB_WIN)}
  550. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  551. {$ELSEIF DEFINED(GLB_LINUX)}
  552. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  553. TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
  554. {$IFEND}
  555. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  556. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  557. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  558. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  559. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  560. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  561. TglTexParameteriv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  562. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  563. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  564. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  565. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  566. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  567. TglTexGeni = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  568. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  569. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  570. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  571. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  572. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  573. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  574. TglTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  575. TglTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  576. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  577. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  578. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  579. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  580. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  581. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  582. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  583. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  584. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  585. procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  586. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  587. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  588. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  589. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  590. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  591. procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  592. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  593. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  594. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  595. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  596. procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  597. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  598. procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  599. procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  600. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  601. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  602. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  603. {$IFEND}
  604. var
  605. GL_VERSION_1_2,
  606. GL_VERSION_1_3,
  607. GL_VERSION_1_4,
  608. GL_VERSION_2_0,
  609. GL_VERSION_3_3,
  610. GL_SGIS_generate_mipmap,
  611. GL_ARB_texture_border_clamp,
  612. GL_ARB_texture_mirrored_repeat,
  613. GL_ARB_texture_rectangle,
  614. GL_ARB_texture_non_power_of_two,
  615. GL_ARB_texture_swizzle,
  616. GL_ARB_texture_cube_map,
  617. GL_IBM_texture_mirrored_repeat,
  618. GL_NV_texture_rectangle,
  619. GL_EXT_texture_edge_clamp,
  620. GL_EXT_texture_rectangle,
  621. GL_EXT_texture_swizzle,
  622. GL_EXT_texture_cube_map,
  623. GL_EXT_texture_filter_anisotropic: Boolean;
  624. glCompressedTexImage1D: TglCompressedTexImage1D;
  625. glCompressedTexImage2D: TglCompressedTexImage2D;
  626. glGetCompressedTexImage: TglGetCompressedTexImage;
  627. {$IF DEFINED(GLB_WIN)}
  628. wglGetProcAddress: TwglGetProcAddress;
  629. {$ELSEIF DEFINED(GLB_LINUX)}
  630. glXGetProcAddress: TglXGetProcAddress;
  631. glXGetProcAddressARB: TglXGetProcAddress;
  632. {$IFEND}
  633. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  634. glEnable: TglEnable;
  635. glDisable: TglDisable;
  636. glGetString: TglGetString;
  637. glGetIntegerv: TglGetIntegerv;
  638. glTexParameteri: TglTexParameteri;
  639. glTexParameteriv: TglTexParameteriv;
  640. glTexParameterfv: TglTexParameterfv;
  641. glGetTexParameteriv: TglGetTexParameteriv;
  642. glGetTexParameterfv: TglGetTexParameterfv;
  643. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  644. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  645. glTexGeni: TglTexGeni;
  646. glGenTextures: TglGenTextures;
  647. glBindTexture: TglBindTexture;
  648. glDeleteTextures: TglDeleteTextures;
  649. glAreTexturesResident: TglAreTexturesResident;
  650. glReadPixels: TglReadPixels;
  651. glPixelStorei: TglPixelStorei;
  652. glTexImage1D: TglTexImage1D;
  653. glTexImage2D: TglTexImage2D;
  654. glGetTexImage: TglGetTexImage;
  655. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  656. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  657. {$ENDIF}
  658. {$ENDIF}
  659. type
  660. ////////////////////////////////////////////////////////////////////////////////////////////////////
  661. TglBitmapFormat = (
  662. tfEmpty = 0, //must be smallest value!
  663. tfAlpha4,
  664. tfAlpha8,
  665. tfAlpha12,
  666. tfAlpha16,
  667. tfLuminance4,
  668. tfLuminance8,
  669. tfLuminance12,
  670. tfLuminance16,
  671. tfLuminance4Alpha4,
  672. tfLuminance6Alpha2,
  673. tfLuminance8Alpha8,
  674. tfLuminance12Alpha4,
  675. tfLuminance12Alpha12,
  676. tfLuminance16Alpha16,
  677. tfR3G3B2,
  678. tfRGB4,
  679. tfR5G6B5,
  680. tfRGB5,
  681. tfRGB8,
  682. tfRGB10,
  683. tfRGB12,
  684. tfRGB16,
  685. tfRGBA2,
  686. tfRGBA4,
  687. tfRGB5A1,
  688. tfRGBA8,
  689. tfRGB10A2,
  690. tfRGBA12,
  691. tfRGBA16,
  692. tfBGR4,
  693. tfB5G6R5,
  694. tfBGR5,
  695. tfBGR8,
  696. tfBGR10,
  697. tfBGR12,
  698. tfBGR16,
  699. tfBGRA2,
  700. tfBGRA4,
  701. tfBGR5A1,
  702. tfBGRA8,
  703. tfBGR10A2,
  704. tfBGRA12,
  705. tfBGRA16,
  706. tfDepth16,
  707. tfDepth24,
  708. tfDepth32,
  709. tfS3tcDtx1RGBA,
  710. tfS3tcDtx3RGBA,
  711. tfS3tcDtx5RGBA
  712. );
  713. TglBitmapFileType = (
  714. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  715. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  716. ftDDS,
  717. ftTGA,
  718. ftBMP);
  719. TglBitmapFileTypes = set of TglBitmapFileType;
  720. TglBitmapMipMap = (
  721. mmNone,
  722. mmMipmap,
  723. mmMipmapGlu);
  724. TglBitmapNormalMapFunc = (
  725. nm4Samples,
  726. nmSobel,
  727. nm3x3,
  728. nm5x5);
  729. ////////////////////////////////////////////////////////////////////////////////////////////////////
  730. EglBitmap = class(Exception);
  731. EglBitmapNotSupported = class(Exception);
  732. EglBitmapSizeToLarge = class(EglBitmap);
  733. EglBitmapNonPowerOfTwo = class(EglBitmap);
  734. EglBitmapUnsupportedFormat = class(EglBitmap)
  735. public
  736. constructor Create(const aFormat: TglBitmapFormat); overload;
  737. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  738. end;
  739. ////////////////////////////////////////////////////////////////////////////////////////////////////
  740. TglBitmapColorRec = packed record
  741. case Integer of
  742. 0: (r, g, b, a: Cardinal);
  743. 1: (arr: array[0..3] of Cardinal);
  744. end;
  745. TglBitmapPixelData = packed record
  746. Data, Range: TglBitmapColorRec;
  747. Format: TglBitmapFormat;
  748. end;
  749. PglBitmapPixelData = ^TglBitmapPixelData;
  750. ////////////////////////////////////////////////////////////////////////////////////////////////////
  751. TglBitmapPixelPositionFields = set of (ffX, ffY);
  752. TglBitmapPixelPosition = record
  753. Fields : TglBitmapPixelPositionFields;
  754. X : Word;
  755. Y : Word;
  756. end;
  757. TglBitmapFormatDescriptor = class(TObject)
  758. protected
  759. function GetIsCompressed: Boolean; virtual; abstract;
  760. function GetHasRed: Boolean; virtual; abstract;
  761. function GetHasGreen: Boolean; virtual; abstract;
  762. function GetHasBlue: Boolean; virtual; abstract;
  763. function GetHasAlpha: Boolean; virtual; abstract;
  764. function GetglDataFormat: GLenum; virtual; abstract;
  765. function GetglFormat: GLenum; virtual; abstract;
  766. function GetglInternalFormat: GLenum; virtual; abstract;
  767. public
  768. property IsCompressed: Boolean read GetIsCompressed;
  769. property HasRed: Boolean read GetHasRed;
  770. property HasGreen: Boolean read GetHasGreen;
  771. property HasBlue: Boolean read GetHasBlue;
  772. property HasAlpha: Boolean read GetHasAlpha;
  773. property glFormat: GLenum read GetglFormat;
  774. property glInternalFormat: GLenum read GetglInternalFormat;
  775. property glDataFormat: GLenum read GetglDataFormat;
  776. public
  777. class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  778. end;
  779. ////////////////////////////////////////////////////////////////////////////////////////////////////
  780. TglBitmap = class;
  781. TglBitmapFunctionRec = record
  782. Sender: TglBitmap;
  783. Size: TglBitmapPixelPosition;
  784. Position: TglBitmapPixelPosition;
  785. Source: TglBitmapPixelData;
  786. Dest: TglBitmapPixelData;
  787. Args: Pointer;
  788. end;
  789. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  790. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  791. TglBitmap = class
  792. private
  793. function GetFormatDesc: TglBitmapFormatDescriptor;
  794. protected
  795. fID: GLuint;
  796. fTarget: GLuint;
  797. fAnisotropic: Integer;
  798. fDeleteTextureOnFree: Boolean;
  799. fFreeDataOnDestroy: Boolean;
  800. fFreeDataAfterGenTexture: Boolean;
  801. fData: PByte;
  802. fIsResident: GLboolean;
  803. fBorderColor: array[0..3] of Single;
  804. fDimension: TglBitmapPixelPosition;
  805. fMipMap: TglBitmapMipMap;
  806. fFormat: TglBitmapFormat;
  807. // Mapping
  808. fPixelSize: Integer;
  809. fRowSize: Integer;
  810. // Filtering
  811. fFilterMin: GLenum;
  812. fFilterMag: GLenum;
  813. // TexturWarp
  814. fWrapS: GLenum;
  815. fWrapT: GLenum;
  816. fWrapR: GLenum;
  817. //Swizzle
  818. fSwizzle: array[0..3] of GLenum;
  819. // CustomData
  820. fFilename: String;
  821. fCustomName: String;
  822. fCustomNameW: WideString;
  823. fCustomData: Pointer;
  824. //Getter
  825. function GetWidth: Integer; virtual;
  826. function GetHeight: Integer; virtual;
  827. function GetFileWidth: Integer; virtual;
  828. function GetFileHeight: Integer; virtual;
  829. //Setter
  830. procedure SetCustomData(const aValue: Pointer);
  831. procedure SetCustomName(const aValue: String);
  832. procedure SetCustomNameW(const aValue: WideString);
  833. procedure SetFreeDataOnDestroy(const aValue: Boolean);
  834. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  835. procedure SetFormat(const aValue: TglBitmapFormat);
  836. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  837. procedure SetID(const aValue: Cardinal);
  838. procedure SetMipMap(const aValue: TglBitmapMipMap);
  839. procedure SetTarget(const aValue: Cardinal);
  840. procedure SetAnisotropic(const aValue: Integer);
  841. procedure CreateID;
  842. procedure SetupParameters(out aBuildWithGlu: Boolean);
  843. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  844. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method
  845. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  846. function FlipHorz: Boolean; virtual;
  847. function FlipVert: Boolean; virtual;
  848. property Width: Integer read GetWidth;
  849. property Height: Integer read GetHeight;
  850. property FileWidth: Integer read GetFileWidth;
  851. property FileHeight: Integer read GetFileHeight;
  852. public
  853. //Properties
  854. property ID: Cardinal read fID write SetID;
  855. property Target: Cardinal read fTarget write SetTarget;
  856. property Format: TglBitmapFormat read fFormat write SetFormat;
  857. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  858. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  859. property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc;
  860. property Filename: String read fFilename;
  861. property CustomName: String read fCustomName write SetCustomName;
  862. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  863. property CustomData: Pointer read fCustomData write SetCustomData;
  864. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  865. property FreeDataOnDestroy: Boolean read fFreeDataOnDestroy write SetFreeDataOnDestroy;
  866. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  867. property Dimension: TglBitmapPixelPosition read fDimension;
  868. property Data: PByte read fData;
  869. property IsResident: GLboolean read fIsResident;
  870. procedure AfterConstruction; override;
  871. procedure BeforeDestruction; override;
  872. procedure PrepareResType(var aResource: String; var aResType: PChar);
  873. //Load
  874. procedure LoadFromFile(const aFilename: String);
  875. procedure LoadFromStream(const aStream: TStream); virtual;
  876. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  877. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  878. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  879. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  880. //Save
  881. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  882. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  883. //Convert
  884. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  885. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  886. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  887. public
  888. //Alpha & Co
  889. {$IFDEF GLB_SDL}
  890. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  891. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  892. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  893. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  894. const aArgs: Pointer = nil): Boolean;
  895. {$ENDIF}
  896. {$IFDEF GLB_DELPHI}
  897. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  898. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  899. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  900. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  901. const aArgs: Pointer = nil): Boolean;
  902. {$ENDIF}
  903. {$IFDEF GLB_LAZARUS}
  904. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  905. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  906. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  907. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  908. const aArgs: Pointer = nil): Boolean;
  909. {$ENDIF}
  910. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  911. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  912. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  913. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  914. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  915. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  916. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  917. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  918. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  919. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  920. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  921. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  922. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  923. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  924. function RemoveAlpha: Boolean; virtual;
  925. public
  926. //Common
  927. function Clone: TglBitmap;
  928. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  929. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  930. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  931. procedure FreeData;
  932. //ColorFill
  933. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  934. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  935. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  936. //TexParameters
  937. procedure SetFilter(const aMin, aMag: GLenum);
  938. procedure SetWrap(
  939. const S: GLenum = GL_CLAMP_TO_EDGE;
  940. const T: GLenum = GL_CLAMP_TO_EDGE;
  941. const R: GLenum = GL_CLAMP_TO_EDGE);
  942. procedure SetSwizzle(const r, g, b, a: GLenum);
  943. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  944. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  945. //Constructors
  946. constructor Create; overload;
  947. constructor Create(const aFileName: String); overload;
  948. constructor Create(const aStream: TStream); overload;
  949. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  950. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  951. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  952. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  953. private
  954. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  955. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  956. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  957. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  958. function LoadBMP(const aStream: TStream): Boolean; virtual;
  959. procedure SaveBMP(const aStream: TStream); virtual;
  960. function LoadTGA(const aStream: TStream): Boolean; virtual;
  961. procedure SaveTGA(const aStream: TStream); virtual;
  962. function LoadDDS(const aStream: TStream): Boolean; virtual;
  963. procedure SaveDDS(const aStream: TStream); virtual;
  964. end;
  965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  966. TglBitmap1D = class(TglBitmap)
  967. protected
  968. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  969. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  970. procedure UploadData(const aBuildWithGlu: Boolean);
  971. public
  972. property Width;
  973. procedure AfterConstruction; override;
  974. function FlipHorz: Boolean; override;
  975. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  976. end;
  977. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  978. TglBitmap2D = class(TglBitmap)
  979. protected
  980. fLines: array of PByte;
  981. function GetScanline(const aIndex: Integer): Pointer;
  982. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  983. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  984. procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  985. public
  986. property Width;
  987. property Height;
  988. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  989. procedure AfterConstruction; override;
  990. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  991. procedure GetDataFromTexture;
  992. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  993. function FlipHorz: Boolean; override;
  994. function FlipVert: Boolean; override;
  995. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  996. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  997. end;
  998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  999. TglBitmapCubeMap = class(TglBitmap2D)
  1000. protected
  1001. fGenMode: Integer;
  1002. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  1003. public
  1004. procedure AfterConstruction; override;
  1005. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  1006. procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  1007. procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  1008. end;
  1009. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1010. TglBitmapNormalMap = class(TglBitmapCubeMap)
  1011. public
  1012. procedure AfterConstruction; override;
  1013. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  1014. end;
  1015. const
  1016. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1017. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1018. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1019. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1020. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1021. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1022. procedure glBitmapSetDefaultWrap(
  1023. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1024. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1025. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1026. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1027. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1028. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1029. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1030. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1031. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1032. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1033. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1034. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1035. var
  1036. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1037. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1038. glBitmapDefaultFormat: TglBitmapFormat;
  1039. glBitmapDefaultMipmap: TglBitmapMipMap;
  1040. glBitmapDefaultFilterMin: Cardinal;
  1041. glBitmapDefaultFilterMag: Cardinal;
  1042. glBitmapDefaultWrapS: Cardinal;
  1043. glBitmapDefaultWrapT: Cardinal;
  1044. glBitmapDefaultWrapR: Cardinal;
  1045. glDefaultSwizzle: array[0..3] of GLenum;
  1046. {$IFDEF GLB_DELPHI}
  1047. function CreateGrayPalette: HPALETTE;
  1048. {$ENDIF}
  1049. implementation
  1050. uses
  1051. Math, syncobjs, typinfo
  1052. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1053. type
  1054. {$IFNDEF fpc}
  1055. QWord = System.UInt64;
  1056. PQWord = ^QWord;
  1057. PtrInt = Longint;
  1058. PtrUInt = DWord;
  1059. {$ENDIF}
  1060. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1061. TShiftRec = packed record
  1062. case Integer of
  1063. 0: (r, g, b, a: Byte);
  1064. 1: (arr: array[0..3] of Byte);
  1065. end;
  1066. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1067. private
  1068. function GetRedMask: QWord;
  1069. function GetGreenMask: QWord;
  1070. function GetBlueMask: QWord;
  1071. function GetAlphaMask: QWord;
  1072. protected
  1073. fFormat: TglBitmapFormat;
  1074. fWithAlpha: TglBitmapFormat;
  1075. fWithoutAlpha: TglBitmapFormat;
  1076. fRGBInverted: TglBitmapFormat;
  1077. fUncompressed: TglBitmapFormat;
  1078. fPixelSize: Single;
  1079. fIsCompressed: Boolean;
  1080. fRange: TglBitmapColorRec;
  1081. fShift: TShiftRec;
  1082. fglFormat: GLenum;
  1083. fglInternalFormat: GLenum;
  1084. fglDataFormat: GLenum;
  1085. function GetIsCompressed: Boolean; override;
  1086. function GetHasRed: Boolean; override;
  1087. function GetHasGreen: Boolean; override;
  1088. function GetHasBlue: Boolean; override;
  1089. function GetHasAlpha: Boolean; override;
  1090. function GetglFormat: GLenum; override;
  1091. function GetglInternalFormat: GLenum; override;
  1092. function GetglDataFormat: GLenum; override;
  1093. function GetComponents: Integer; virtual;
  1094. public
  1095. property Format: TglBitmapFormat read fFormat;
  1096. property WithAlpha: TglBitmapFormat read fWithAlpha;
  1097. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  1098. property RGBInverted: TglBitmapFormat read fRGBInverted;
  1099. property Components: Integer read GetComponents;
  1100. property PixelSize: Single read fPixelSize;
  1101. property Range: TglBitmapColorRec read fRange;
  1102. property Shift: TShiftRec read fShift;
  1103. property RedMask: QWord read GetRedMask;
  1104. property GreenMask: QWord read GetGreenMask;
  1105. property BlueMask: QWord read GetBlueMask;
  1106. property AlphaMask: QWord read GetAlphaMask;
  1107. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1108. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1109. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1110. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1111. function CreateMappingData: Pointer; virtual;
  1112. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1113. function IsEmpty: Boolean; virtual;
  1114. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  1115. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1116. constructor Create; virtual;
  1117. public
  1118. class procedure Init;
  1119. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1120. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1121. class procedure Clear;
  1122. class procedure Finalize;
  1123. end;
  1124. TFormatDescriptorClass = class of TFormatDescriptor;
  1125. TfdEmpty = class(TFormatDescriptor);
  1126. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1127. TfdAlpha_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. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1133. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1134. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1135. constructor Create; override;
  1136. end;
  1137. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1138. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1139. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1140. constructor Create; override;
  1141. end;
  1142. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1143. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1144. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1145. constructor Create; override;
  1146. end;
  1147. TfdRGB_UB3 = class(TFormatDescriptor) //3* 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. TfdBGR_UB3 = class(TFormatDescriptor) //3* 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. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1158. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1159. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1160. constructor Create; override;
  1161. end;
  1162. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1163. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1164. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1165. constructor Create; override;
  1166. end;
  1167. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1168. TfdAlpha_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. TfdLuminance_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. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1179. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1180. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1181. constructor Create; override;
  1182. end;
  1183. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1184. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1185. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1186. constructor Create; override;
  1187. end;
  1188. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1189. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1190. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1191. constructor Create; override;
  1192. end;
  1193. TfdRGB_US3 = class(TFormatDescriptor) //3* 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. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1199. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1200. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1201. constructor Create; override;
  1202. end;
  1203. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1204. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1205. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1206. constructor Create; override;
  1207. end;
  1208. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1209. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1210. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1211. constructor Create; override;
  1212. end;
  1213. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1214. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  1215. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1216. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1217. constructor Create; override;
  1218. end;
  1219. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1220. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1221. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1222. constructor Create; override;
  1223. end;
  1224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1225. TfdAlpha4 = class(TfdAlpha_UB1)
  1226. constructor Create; override;
  1227. end;
  1228. TfdAlpha8 = class(TfdAlpha_UB1)
  1229. constructor Create; override;
  1230. end;
  1231. TfdAlpha12 = class(TfdAlpha_US1)
  1232. constructor Create; override;
  1233. end;
  1234. TfdAlpha16 = class(TfdAlpha_US1)
  1235. constructor Create; override;
  1236. end;
  1237. TfdLuminance4 = class(TfdLuminance_UB1)
  1238. constructor Create; override;
  1239. end;
  1240. TfdLuminance8 = class(TfdLuminance_UB1)
  1241. constructor Create; override;
  1242. end;
  1243. TfdLuminance12 = class(TfdLuminance_US1)
  1244. constructor Create; override;
  1245. end;
  1246. TfdLuminance16 = class(TfdLuminance_US1)
  1247. constructor Create; override;
  1248. end;
  1249. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1250. constructor Create; override;
  1251. end;
  1252. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1253. constructor Create; override;
  1254. end;
  1255. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1256. constructor Create; override;
  1257. end;
  1258. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1259. constructor Create; override;
  1260. end;
  1261. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1262. constructor Create; override;
  1263. end;
  1264. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1265. constructor Create; override;
  1266. end;
  1267. TfdR3G3B2 = class(TfdUniversal_UB1)
  1268. constructor Create; override;
  1269. end;
  1270. TfdRGB4 = class(TfdUniversal_US1)
  1271. constructor Create; override;
  1272. end;
  1273. TfdR5G6B5 = class(TfdUniversal_US1)
  1274. constructor Create; override;
  1275. end;
  1276. TfdRGB5 = class(TfdUniversal_US1)
  1277. constructor Create; override;
  1278. end;
  1279. TfdRGB8 = class(TfdRGB_UB3)
  1280. constructor Create; override;
  1281. end;
  1282. TfdRGB10 = class(TfdUniversal_UI1)
  1283. constructor Create; override;
  1284. end;
  1285. TfdRGB12 = class(TfdRGB_US3)
  1286. constructor Create; override;
  1287. end;
  1288. TfdRGB16 = class(TfdRGB_US3)
  1289. constructor Create; override;
  1290. end;
  1291. TfdRGBA2 = class(TfdRGBA_UB4)
  1292. constructor Create; override;
  1293. end;
  1294. TfdRGBA4 = class(TfdUniversal_US1)
  1295. constructor Create; override;
  1296. end;
  1297. TfdRGB5A1 = class(TfdUniversal_US1)
  1298. constructor Create; override;
  1299. end;
  1300. TfdRGBA8 = class(TfdRGBA_UB4)
  1301. constructor Create; override;
  1302. end;
  1303. TfdRGB10A2 = class(TfdUniversal_UI1)
  1304. constructor Create; override;
  1305. end;
  1306. TfdRGBA12 = class(TfdRGBA_US4)
  1307. constructor Create; override;
  1308. end;
  1309. TfdRGBA16 = class(TfdRGBA_US4)
  1310. constructor Create; override;
  1311. end;
  1312. TfdBGR4 = class(TfdUniversal_US1)
  1313. constructor Create; override;
  1314. end;
  1315. TfdB5G6R5 = class(TfdUniversal_US1)
  1316. constructor Create; override;
  1317. end;
  1318. TfdBGR5 = class(TfdUniversal_US1)
  1319. constructor Create; override;
  1320. end;
  1321. TfdBGR8 = class(TfdBGR_UB3)
  1322. constructor Create; override;
  1323. end;
  1324. TfdBGR10 = class(TfdUniversal_UI1)
  1325. constructor Create; override;
  1326. end;
  1327. TfdBGR12 = class(TfdBGR_US3)
  1328. constructor Create; override;
  1329. end;
  1330. TfdBGR16 = class(TfdBGR_US3)
  1331. constructor Create; override;
  1332. end;
  1333. TfdBGRA2 = class(TfdBGRA_UB4)
  1334. constructor Create; override;
  1335. end;
  1336. TfdBGRA4 = class(TfdUniversal_US1)
  1337. constructor Create; override;
  1338. end;
  1339. TfdBGR5A1 = class(TfdUniversal_US1)
  1340. constructor Create; override;
  1341. end;
  1342. TfdBGRA8 = class(TfdBGRA_UB4)
  1343. constructor Create; override;
  1344. end;
  1345. TfdBGR10A2 = class(TfdUniversal_UI1)
  1346. constructor Create; override;
  1347. end;
  1348. TfdBGRA12 = class(TfdBGRA_US4)
  1349. constructor Create; override;
  1350. end;
  1351. TfdBGRA16 = class(TfdBGRA_US4)
  1352. constructor Create; override;
  1353. end;
  1354. TfdDepth16 = class(TfdDepth_US1)
  1355. constructor Create; override;
  1356. end;
  1357. TfdDepth24 = class(TfdDepth_UI1)
  1358. constructor Create; override;
  1359. end;
  1360. TfdDepth32 = class(TfdDepth_UI1)
  1361. constructor Create; override;
  1362. end;
  1363. TfdS3tcDtx1RGBA = 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. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1369. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1370. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1371. constructor Create; override;
  1372. end;
  1373. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1374. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1375. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1376. constructor Create; override;
  1377. end;
  1378. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1379. TbmpBitfieldFormat = class(TFormatDescriptor)
  1380. private
  1381. procedure SetRedMask (const aValue: QWord);
  1382. procedure SetGreenMask(const aValue: QWord);
  1383. procedure SetBlueMask (const aValue: QWord);
  1384. procedure SetAlphaMask(const aValue: QWord);
  1385. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1386. public
  1387. property RedMask: QWord read GetRedMask write SetRedMask;
  1388. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1389. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1390. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1391. property PixelSize: Single read fPixelSize write fPixelSize;
  1392. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1393. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1394. end;
  1395. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1396. TbmpColorTableEnty = packed record
  1397. b, g, r, a: Byte;
  1398. end;
  1399. TbmpColorTable = array of TbmpColorTableEnty;
  1400. TbmpColorTableFormat = class(TFormatDescriptor)
  1401. private
  1402. fColorTable: TbmpColorTable;
  1403. public
  1404. property PixelSize: Single read fPixelSize write fPixelSize;
  1405. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1406. property Range: TglBitmapColorRec read fRange write fRange;
  1407. property Shift: TShiftRec read fShift write fShift;
  1408. property Format: TglBitmapFormat read fFormat write fFormat;
  1409. procedure CreateColorTable;
  1410. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1411. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1412. destructor Destroy; override;
  1413. end;
  1414. const
  1415. LUMINANCE_WEIGHT_R = 0.30;
  1416. LUMINANCE_WEIGHT_G = 0.59;
  1417. LUMINANCE_WEIGHT_B = 0.11;
  1418. ALPHA_WEIGHT_R = 0.30;
  1419. ALPHA_WEIGHT_G = 0.59;
  1420. ALPHA_WEIGHT_B = 0.11;
  1421. DEPTH_WEIGHT_R = 0.333333333;
  1422. DEPTH_WEIGHT_G = 0.333333333;
  1423. DEPTH_WEIGHT_B = 0.333333333;
  1424. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1425. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1426. TfdEmpty,
  1427. TfdAlpha4,
  1428. TfdAlpha8,
  1429. TfdAlpha12,
  1430. TfdAlpha16,
  1431. TfdLuminance4,
  1432. TfdLuminance8,
  1433. TfdLuminance12,
  1434. TfdLuminance16,
  1435. TfdLuminance4Alpha4,
  1436. TfdLuminance6Alpha2,
  1437. TfdLuminance8Alpha8,
  1438. TfdLuminance12Alpha4,
  1439. TfdLuminance12Alpha12,
  1440. TfdLuminance16Alpha16,
  1441. TfdR3G3B2,
  1442. TfdRGB4,
  1443. TfdR5G6B5,
  1444. TfdRGB5,
  1445. TfdRGB8,
  1446. TfdRGB10,
  1447. TfdRGB12,
  1448. TfdRGB16,
  1449. TfdRGBA2,
  1450. TfdRGBA4,
  1451. TfdRGB5A1,
  1452. TfdRGBA8,
  1453. TfdRGB10A2,
  1454. TfdRGBA12,
  1455. TfdRGBA16,
  1456. TfdBGR4,
  1457. TfdB5G6R5,
  1458. TfdBGR5,
  1459. TfdBGR8,
  1460. TfdBGR10,
  1461. TfdBGR12,
  1462. TfdBGR16,
  1463. TfdBGRA2,
  1464. TfdBGRA4,
  1465. TfdBGR5A1,
  1466. TfdBGRA8,
  1467. TfdBGR10A2,
  1468. TfdBGRA12,
  1469. TfdBGRA16,
  1470. TfdDepth16,
  1471. TfdDepth24,
  1472. TfdDepth32,
  1473. TfdS3tcDtx1RGBA,
  1474. TfdS3tcDtx3RGBA,
  1475. TfdS3tcDtx5RGBA
  1476. );
  1477. var
  1478. FormatDescriptorCS: TCriticalSection;
  1479. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1480. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1481. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1482. begin
  1483. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1484. end;
  1485. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1486. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1487. begin
  1488. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1489. end;
  1490. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1491. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1492. begin
  1493. result.Fields := [];
  1494. if X >= 0 then
  1495. result.Fields := result.Fields + [ffX];
  1496. if Y >= 0 then
  1497. result.Fields := result.Fields + [ffY];
  1498. result.X := Max(0, X);
  1499. result.Y := Max(0, Y);
  1500. end;
  1501. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1502. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1503. begin
  1504. result.r := r;
  1505. result.g := g;
  1506. result.b := b;
  1507. result.a := a;
  1508. end;
  1509. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1510. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1511. var
  1512. i: Integer;
  1513. begin
  1514. result := false;
  1515. for i := 0 to high(r1.arr) do
  1516. if (r1.arr[i] <> r2.arr[i]) then
  1517. exit;
  1518. result := true;
  1519. end;
  1520. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1521. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1522. begin
  1523. result.r := r;
  1524. result.g := g;
  1525. result.b := b;
  1526. result.a := a;
  1527. end;
  1528. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1529. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1530. begin
  1531. result := [];
  1532. if (aFormat in [
  1533. //4 bbp
  1534. tfLuminance4,
  1535. //8bpp
  1536. tfR3G3B2, tfLuminance8,
  1537. //16bpp
  1538. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1539. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1540. //24bpp
  1541. tfBGR8, tfRGB8,
  1542. //32bpp
  1543. tfRGB10, tfRGB10A2, tfRGBA8,
  1544. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1545. result := result + [ftBMP];
  1546. if (aFormat in [
  1547. //8 bpp
  1548. tfLuminance8, tfAlpha8,
  1549. //16 bpp
  1550. tfLuminance16, tfLuminance8Alpha8,
  1551. tfRGB5, tfRGB5A1, tfRGBA4,
  1552. tfBGR5, tfBGR5A1, tfBGRA4,
  1553. //24 bpp
  1554. tfRGB8, tfBGR8,
  1555. //32 bpp
  1556. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1557. result := result + [ftTGA];
  1558. if (aFormat in [
  1559. //8 bpp
  1560. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1561. tfR3G3B2, tfRGBA2, tfBGRA2,
  1562. //16 bpp
  1563. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1564. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1565. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1566. //24 bpp
  1567. tfRGB8, tfBGR8,
  1568. //32 bbp
  1569. tfLuminance16Alpha16,
  1570. tfRGBA8, tfRGB10A2,
  1571. tfBGRA8, tfBGR10A2,
  1572. //compressed
  1573. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1574. result := result + [ftDDS];
  1575. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1576. if aFormat in [
  1577. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1578. tfRGB8, tfRGBA8,
  1579. tfBGR8, tfBGRA8] then
  1580. result := result + [ftPNG];
  1581. {$ENDIF}
  1582. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1583. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1584. result := result + [ftJPEG];
  1585. {$ENDIF}
  1586. end;
  1587. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1588. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1589. begin
  1590. while (aNumber and 1) = 0 do
  1591. aNumber := aNumber shr 1;
  1592. result := aNumber = 1;
  1593. end;
  1594. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1595. function GetTopMostBit(aBitSet: QWord): Integer;
  1596. begin
  1597. result := 0;
  1598. while aBitSet > 0 do begin
  1599. inc(result);
  1600. aBitSet := aBitSet shr 1;
  1601. end;
  1602. end;
  1603. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1604. function CountSetBits(aBitSet: QWord): Integer;
  1605. begin
  1606. result := 0;
  1607. while aBitSet > 0 do begin
  1608. if (aBitSet and 1) = 1 then
  1609. inc(result);
  1610. aBitSet := aBitSet shr 1;
  1611. end;
  1612. end;
  1613. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1614. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1615. begin
  1616. result := Trunc(
  1617. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1618. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1619. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1620. end;
  1621. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1622. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1623. begin
  1624. result := Trunc(
  1625. DEPTH_WEIGHT_R * aPixel.Data.r +
  1626. DEPTH_WEIGHT_G * aPixel.Data.g +
  1627. DEPTH_WEIGHT_B * aPixel.Data.b);
  1628. end;
  1629. {$IFDEF GLB_NATIVE_OGL}
  1630. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1631. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1632. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1633. var
  1634. GL_LibHandle: Pointer = nil;
  1635. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
  1636. begin
  1637. if not Assigned(aLibHandle) then
  1638. aLibHandle := GL_LibHandle;
  1639. {$IF DEFINED(GLB_WIN)}
  1640. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1641. if Assigned(result) then
  1642. exit;
  1643. if Assigned(wglGetProcAddress) then
  1644. result := wglGetProcAddress(aProcName);
  1645. {$ELSEIF DEFINED(GLB_LINUX)}
  1646. if Assigned(glXGetProcAddress) then begin
  1647. result := glXGetProcAddress(aProcName);
  1648. if Assigned(result) then
  1649. exit;
  1650. end;
  1651. if Assigned(glXGetProcAddressARB) then begin
  1652. result := glXGetProcAddressARB(aProcName);
  1653. if Assigned(result) then
  1654. exit;
  1655. end;
  1656. result := dlsym(aLibHandle, aProcName);
  1657. {$IFEND}
  1658. if not Assigned(result) and aRaiseOnErr then
  1659. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1660. end;
  1661. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1662. var
  1663. GLU_LibHandle: Pointer = nil;
  1664. OpenGLInitialized: Boolean;
  1665. InitOpenGLCS: TCriticalSection;
  1666. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1667. procedure glbInitOpenGL;
  1668. ////////////////////////////////////////////////////////////////////////////////
  1669. function glbLoadLibrary(const aName: PChar): Pointer;
  1670. begin
  1671. {$IF DEFINED(GLB_WIN)}
  1672. result := {%H-}Pointer(LoadLibrary(aName));
  1673. {$ELSEIF DEFINED(GLB_LINUX)}
  1674. result := dlopen(Name, RTLD_LAZY);
  1675. {$ELSE}
  1676. result := nil;
  1677. {$IFEND}
  1678. end;
  1679. ////////////////////////////////////////////////////////////////////////////////
  1680. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1681. begin
  1682. result := false;
  1683. if not Assigned(aLibHandle) then
  1684. exit;
  1685. {$IF DEFINED(GLB_WIN)}
  1686. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1687. {$ELSEIF DEFINED(GLB_LINUX)}
  1688. Result := dlclose(aLibHandle) = 0;
  1689. {$IFEND}
  1690. end;
  1691. begin
  1692. if Assigned(GL_LibHandle) then
  1693. glbFreeLibrary(GL_LibHandle);
  1694. if Assigned(GLU_LibHandle) then
  1695. glbFreeLibrary(GLU_LibHandle);
  1696. GL_LibHandle := glbLoadLibrary(libopengl);
  1697. if not Assigned(GL_LibHandle) then
  1698. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1699. GLU_LibHandle := glbLoadLibrary(libglu);
  1700. if not Assigned(GLU_LibHandle) then
  1701. raise EglBitmap.Create('unable to load library: ' + libglu);
  1702. {$IF DEFINED(GLB_WIN)}
  1703. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1704. {$ELSEIF DEFINED(GLB_LINUX)}
  1705. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1706. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1707. {$IFEND}
  1708. glEnable := glbGetProcAddress('glEnable');
  1709. glDisable := glbGetProcAddress('glDisable');
  1710. glGetString := glbGetProcAddress('glGetString');
  1711. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1712. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1713. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1714. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1715. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1716. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1717. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1718. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1719. glTexGeni := glbGetProcAddress('glTexGeni');
  1720. glGenTextures := glbGetProcAddress('glGenTextures');
  1721. glBindTexture := glbGetProcAddress('glBindTexture');
  1722. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1723. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1724. glReadPixels := glbGetProcAddress('glReadPixels');
  1725. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1726. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1727. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1728. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1729. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1730. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1731. end;
  1732. {$ENDIF}
  1733. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1734. procedure glbReadOpenGLExtensions;
  1735. var
  1736. Buffer: AnsiString;
  1737. MajorVersion, MinorVersion: Integer;
  1738. ///////////////////////////////////////////////////////////////////////////////////////////
  1739. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1740. var
  1741. Separator: Integer;
  1742. begin
  1743. aMinor := 0;
  1744. aMajor := 0;
  1745. Separator := Pos(AnsiString('.'), aBuffer);
  1746. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1747. (aBuffer[Separator - 1] in ['0'..'9']) and
  1748. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1749. Dec(Separator);
  1750. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1751. Dec(Separator);
  1752. Delete(aBuffer, 1, Separator);
  1753. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1754. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1755. Inc(Separator);
  1756. Delete(aBuffer, Separator, 255);
  1757. Separator := Pos(AnsiString('.'), aBuffer);
  1758. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1759. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1760. end;
  1761. end;
  1762. ///////////////////////////////////////////////////////////////////////////////////////////
  1763. function CheckExtension(const Extension: AnsiString): Boolean;
  1764. var
  1765. ExtPos: Integer;
  1766. begin
  1767. ExtPos := Pos(Extension, Buffer);
  1768. result := ExtPos > 0;
  1769. if result then
  1770. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1771. end;
  1772. ///////////////////////////////////////////////////////////////////////////////////////////
  1773. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1774. begin
  1775. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1776. end;
  1777. begin
  1778. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1779. InitOpenGLCS.Enter;
  1780. try
  1781. if not OpenGLInitialized then begin
  1782. glbInitOpenGL;
  1783. OpenGLInitialized := true;
  1784. end;
  1785. finally
  1786. InitOpenGLCS.Leave;
  1787. end;
  1788. {$ENDIF}
  1789. // Version
  1790. Buffer := glGetString(GL_VERSION);
  1791. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1792. GL_VERSION_1_2 := CheckVersion(1, 2);
  1793. GL_VERSION_1_3 := CheckVersion(1, 3);
  1794. GL_VERSION_1_4 := CheckVersion(1, 4);
  1795. GL_VERSION_2_0 := CheckVersion(2, 0);
  1796. GL_VERSION_3_3 := CheckVersion(3, 3);
  1797. // Extensions
  1798. Buffer := glGetString(GL_EXTENSIONS);
  1799. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1800. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1801. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1802. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1803. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1804. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1805. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1806. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1807. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1808. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1809. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1810. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1811. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1812. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1813. if GL_VERSION_1_3 then begin
  1814. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1815. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1816. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1817. end else begin
  1818. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false);
  1819. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false);
  1820. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
  1821. end;
  1822. end;
  1823. {$ENDIF}
  1824. {$IFDEF GLB_SDL_IMAGE}
  1825. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1826. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1827. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1828. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1829. begin
  1830. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1831. end;
  1832. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1833. begin
  1834. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1835. end;
  1836. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1837. begin
  1838. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1839. end;
  1840. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1841. begin
  1842. result := 0;
  1843. end;
  1844. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1845. begin
  1846. result := SDL_AllocRW;
  1847. if result = nil then
  1848. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1849. result^.seek := glBitmapRWseek;
  1850. result^.read := glBitmapRWread;
  1851. result^.write := glBitmapRWwrite;
  1852. result^.close := glBitmapRWclose;
  1853. result^.unknown.data1 := Stream;
  1854. end;
  1855. {$ENDIF}
  1856. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1857. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1858. begin
  1859. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1860. end;
  1861. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1862. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1863. begin
  1864. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1865. end;
  1866. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1867. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1868. begin
  1869. glBitmapDefaultMipmap := aValue;
  1870. end;
  1871. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1872. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1873. begin
  1874. glBitmapDefaultFormat := aFormat;
  1875. end;
  1876. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1877. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1878. begin
  1879. glBitmapDefaultFilterMin := aMin;
  1880. glBitmapDefaultFilterMag := aMag;
  1881. end;
  1882. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1883. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1884. begin
  1885. glBitmapDefaultWrapS := S;
  1886. glBitmapDefaultWrapT := T;
  1887. glBitmapDefaultWrapR := R;
  1888. end;
  1889. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1890. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1891. begin
  1892. glDefaultSwizzle[0] := r;
  1893. glDefaultSwizzle[1] := g;
  1894. glDefaultSwizzle[2] := b;
  1895. glDefaultSwizzle[3] := a;
  1896. end;
  1897. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1898. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1899. begin
  1900. result := glBitmapDefaultDeleteTextureOnFree;
  1901. end;
  1902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1903. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1904. begin
  1905. result := glBitmapDefaultFreeDataAfterGenTextures;
  1906. end;
  1907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1908. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1909. begin
  1910. result := glBitmapDefaultMipmap;
  1911. end;
  1912. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1913. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1914. begin
  1915. result := glBitmapDefaultFormat;
  1916. end;
  1917. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1918. procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
  1919. begin
  1920. aMin := glBitmapDefaultFilterMin;
  1921. aMag := glBitmapDefaultFilterMag;
  1922. end;
  1923. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1924. procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
  1925. begin
  1926. S := glBitmapDefaultWrapS;
  1927. T := glBitmapDefaultWrapT;
  1928. R := glBitmapDefaultWrapR;
  1929. end;
  1930. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1931. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1932. begin
  1933. r := glDefaultSwizzle[0];
  1934. g := glDefaultSwizzle[1];
  1935. b := glDefaultSwizzle[2];
  1936. a := glDefaultSwizzle[3];
  1937. end;
  1938. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1939. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1940. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1941. function TFormatDescriptor.GetRedMask: QWord;
  1942. begin
  1943. result := fRange.r shl fShift.r;
  1944. end;
  1945. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1946. function TFormatDescriptor.GetGreenMask: QWord;
  1947. begin
  1948. result := fRange.g shl fShift.g;
  1949. end;
  1950. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1951. function TFormatDescriptor.GetBlueMask: QWord;
  1952. begin
  1953. result := fRange.b shl fShift.b;
  1954. end;
  1955. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1956. function TFormatDescriptor.GetAlphaMask: QWord;
  1957. begin
  1958. result := fRange.a shl fShift.a;
  1959. end;
  1960. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1961. function TFormatDescriptor.GetIsCompressed: Boolean;
  1962. begin
  1963. result := fIsCompressed;
  1964. end;
  1965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1966. function TFormatDescriptor.GetHasRed: Boolean;
  1967. begin
  1968. result := (fRange.r > 0);
  1969. end;
  1970. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1971. function TFormatDescriptor.GetHasGreen: Boolean;
  1972. begin
  1973. result := (fRange.g > 0);
  1974. end;
  1975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1976. function TFormatDescriptor.GetHasBlue: Boolean;
  1977. begin
  1978. result := (fRange.b > 0);
  1979. end;
  1980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1981. function TFormatDescriptor.GetHasAlpha: Boolean;
  1982. begin
  1983. result := (fRange.a > 0);
  1984. end;
  1985. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1986. function TFormatDescriptor.GetglFormat: GLenum;
  1987. begin
  1988. result := fglFormat;
  1989. end;
  1990. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1991. function TFormatDescriptor.GetglInternalFormat: GLenum;
  1992. begin
  1993. result := fglInternalFormat;
  1994. end;
  1995. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1996. function TFormatDescriptor.GetglDataFormat: GLenum;
  1997. begin
  1998. result := fglDataFormat;
  1999. end;
  2000. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2001. function TFormatDescriptor.GetComponents: Integer;
  2002. var
  2003. i: Integer;
  2004. begin
  2005. result := 0;
  2006. for i := 0 to 3 do
  2007. if (fRange.arr[i] > 0) then
  2008. inc(result);
  2009. end;
  2010. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2011. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  2012. var
  2013. w, h: Integer;
  2014. begin
  2015. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  2016. w := Max(1, aSize.X);
  2017. h := Max(1, aSize.Y);
  2018. result := GetSize(w, h);
  2019. end else
  2020. result := 0;
  2021. end;
  2022. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2023. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  2024. begin
  2025. result := 0;
  2026. if (aWidth <= 0) or (aHeight <= 0) then
  2027. exit;
  2028. result := Ceil(aWidth * aHeight * fPixelSize);
  2029. end;
  2030. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2031. function TFormatDescriptor.CreateMappingData: Pointer;
  2032. begin
  2033. result := nil;
  2034. end;
  2035. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2036. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2037. begin
  2038. //DUMMY
  2039. end;
  2040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2041. function TFormatDescriptor.IsEmpty: Boolean;
  2042. begin
  2043. result := (fFormat = tfEmpty);
  2044. end;
  2045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2046. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  2047. begin
  2048. result := false;
  2049. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2050. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2051. if (aRedMask <> RedMask) then
  2052. exit;
  2053. if (aGreenMask <> GreenMask) then
  2054. exit;
  2055. if (aBlueMask <> BlueMask) then
  2056. exit;
  2057. if (aAlphaMask <> AlphaMask) then
  2058. exit;
  2059. result := true;
  2060. end;
  2061. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2062. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2063. begin
  2064. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2065. aPixel.Data := fRange;
  2066. aPixel.Range := fRange;
  2067. aPixel.Format := fFormat;
  2068. end;
  2069. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2070. constructor TFormatDescriptor.Create;
  2071. begin
  2072. inherited Create;
  2073. fFormat := tfEmpty;
  2074. fWithAlpha := tfEmpty;
  2075. fWithoutAlpha := tfEmpty;
  2076. fRGBInverted := tfEmpty;
  2077. fUncompressed := tfEmpty;
  2078. fPixelSize := 0.0;
  2079. fIsCompressed := false;
  2080. fglFormat := 0;
  2081. fglInternalFormat := 0;
  2082. fglDataFormat := 0;
  2083. FillChar(fRange, 0, SizeOf(fRange));
  2084. FillChar(fShift, 0, SizeOf(fShift));
  2085. end;
  2086. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2087. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2088. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2089. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2090. begin
  2091. aData^ := aPixel.Data.a;
  2092. inc(aData);
  2093. end;
  2094. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2095. begin
  2096. aPixel.Data.r := 0;
  2097. aPixel.Data.g := 0;
  2098. aPixel.Data.b := 0;
  2099. aPixel.Data.a := aData^;
  2100. inc(aData);
  2101. end;
  2102. constructor TfdAlpha_UB1.Create;
  2103. begin
  2104. inherited Create;
  2105. fPixelSize := 1.0;
  2106. fRange.a := $FF;
  2107. fglFormat := GL_ALPHA;
  2108. fglDataFormat := GL_UNSIGNED_BYTE;
  2109. end;
  2110. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2111. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2112. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2113. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2114. begin
  2115. aData^ := LuminanceWeight(aPixel);
  2116. inc(aData);
  2117. end;
  2118. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2119. begin
  2120. aPixel.Data.r := aData^;
  2121. aPixel.Data.g := aData^;
  2122. aPixel.Data.b := aData^;
  2123. aPixel.Data.a := 0;
  2124. inc(aData);
  2125. end;
  2126. constructor TfdLuminance_UB1.Create;
  2127. begin
  2128. inherited Create;
  2129. fPixelSize := 1.0;
  2130. fRange.r := $FF;
  2131. fRange.g := $FF;
  2132. fRange.b := $FF;
  2133. fglFormat := GL_LUMINANCE;
  2134. fglDataFormat := GL_UNSIGNED_BYTE;
  2135. end;
  2136. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2137. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2138. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2139. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2140. var
  2141. i: Integer;
  2142. begin
  2143. aData^ := 0;
  2144. for i := 0 to 3 do
  2145. if (fRange.arr[i] > 0) then
  2146. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2147. inc(aData);
  2148. end;
  2149. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2150. var
  2151. i: Integer;
  2152. begin
  2153. for i := 0 to 3 do
  2154. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2155. inc(aData);
  2156. end;
  2157. constructor TfdUniversal_UB1.Create;
  2158. begin
  2159. inherited Create;
  2160. fPixelSize := 1.0;
  2161. end;
  2162. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2163. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2164. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2165. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2166. begin
  2167. inherited Map(aPixel, aData, aMapData);
  2168. aData^ := aPixel.Data.a;
  2169. inc(aData);
  2170. end;
  2171. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2172. begin
  2173. inherited Unmap(aData, aPixel, aMapData);
  2174. aPixel.Data.a := aData^;
  2175. inc(aData);
  2176. end;
  2177. constructor TfdLuminanceAlpha_UB2.Create;
  2178. begin
  2179. inherited Create;
  2180. fPixelSize := 2.0;
  2181. fRange.a := $FF;
  2182. fShift.a := 8;
  2183. fglFormat := GL_LUMINANCE_ALPHA;
  2184. fglDataFormat := GL_UNSIGNED_BYTE;
  2185. end;
  2186. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2187. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2188. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2189. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2190. begin
  2191. aData^ := aPixel.Data.r;
  2192. inc(aData);
  2193. aData^ := aPixel.Data.g;
  2194. inc(aData);
  2195. aData^ := aPixel.Data.b;
  2196. inc(aData);
  2197. end;
  2198. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2199. begin
  2200. aPixel.Data.r := aData^;
  2201. inc(aData);
  2202. aPixel.Data.g := aData^;
  2203. inc(aData);
  2204. aPixel.Data.b := aData^;
  2205. inc(aData);
  2206. aPixel.Data.a := 0;
  2207. end;
  2208. constructor TfdRGB_UB3.Create;
  2209. begin
  2210. inherited Create;
  2211. fPixelSize := 3.0;
  2212. fRange.r := $FF;
  2213. fRange.g := $FF;
  2214. fRange.b := $FF;
  2215. fShift.r := 0;
  2216. fShift.g := 8;
  2217. fShift.b := 16;
  2218. fglFormat := GL_RGB;
  2219. fglDataFormat := GL_UNSIGNED_BYTE;
  2220. end;
  2221. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2222. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2223. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2224. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2225. begin
  2226. aData^ := aPixel.Data.b;
  2227. inc(aData);
  2228. aData^ := aPixel.Data.g;
  2229. inc(aData);
  2230. aData^ := aPixel.Data.r;
  2231. inc(aData);
  2232. end;
  2233. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2234. begin
  2235. aPixel.Data.b := aData^;
  2236. inc(aData);
  2237. aPixel.Data.g := aData^;
  2238. inc(aData);
  2239. aPixel.Data.r := aData^;
  2240. inc(aData);
  2241. aPixel.Data.a := 0;
  2242. end;
  2243. constructor TfdBGR_UB3.Create;
  2244. begin
  2245. fPixelSize := 3.0;
  2246. fRange.r := $FF;
  2247. fRange.g := $FF;
  2248. fRange.b := $FF;
  2249. fShift.r := 16;
  2250. fShift.g := 8;
  2251. fShift.b := 0;
  2252. fglFormat := GL_BGR;
  2253. fglDataFormat := GL_UNSIGNED_BYTE;
  2254. end;
  2255. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2256. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2258. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2259. begin
  2260. inherited Map(aPixel, aData, aMapData);
  2261. aData^ := aPixel.Data.a;
  2262. inc(aData);
  2263. end;
  2264. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2265. begin
  2266. inherited Unmap(aData, aPixel, aMapData);
  2267. aPixel.Data.a := aData^;
  2268. inc(aData);
  2269. end;
  2270. constructor TfdRGBA_UB4.Create;
  2271. begin
  2272. inherited Create;
  2273. fPixelSize := 4.0;
  2274. fRange.a := $FF;
  2275. fShift.a := 24;
  2276. fglFormat := GL_RGBA;
  2277. fglDataFormat := GL_UNSIGNED_BYTE;
  2278. end;
  2279. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2280. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2281. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2282. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2283. begin
  2284. inherited Map(aPixel, aData, aMapData);
  2285. aData^ := aPixel.Data.a;
  2286. inc(aData);
  2287. end;
  2288. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2289. begin
  2290. inherited Unmap(aData, aPixel, aMapData);
  2291. aPixel.Data.a := aData^;
  2292. inc(aData);
  2293. end;
  2294. constructor TfdBGRA_UB4.Create;
  2295. begin
  2296. inherited Create;
  2297. fPixelSize := 4.0;
  2298. fRange.a := $FF;
  2299. fShift.a := 24;
  2300. fglFormat := GL_BGRA;
  2301. fglDataFormat := GL_UNSIGNED_BYTE;
  2302. end;
  2303. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2304. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2305. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2306. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2307. begin
  2308. PWord(aData)^ := aPixel.Data.a;
  2309. inc(aData, 2);
  2310. end;
  2311. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2312. begin
  2313. aPixel.Data.r := 0;
  2314. aPixel.Data.g := 0;
  2315. aPixel.Data.b := 0;
  2316. aPixel.Data.a := PWord(aData)^;
  2317. inc(aData, 2);
  2318. end;
  2319. constructor TfdAlpha_US1.Create;
  2320. begin
  2321. inherited Create;
  2322. fPixelSize := 2.0;
  2323. fRange.a := $FFFF;
  2324. fglFormat := GL_ALPHA;
  2325. fglDataFormat := GL_UNSIGNED_SHORT;
  2326. end;
  2327. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2328. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2329. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2330. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2331. begin
  2332. PWord(aData)^ := LuminanceWeight(aPixel);
  2333. inc(aData, 2);
  2334. end;
  2335. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2336. begin
  2337. aPixel.Data.r := PWord(aData)^;
  2338. aPixel.Data.g := PWord(aData)^;
  2339. aPixel.Data.b := PWord(aData)^;
  2340. aPixel.Data.a := 0;
  2341. inc(aData, 2);
  2342. end;
  2343. constructor TfdLuminance_US1.Create;
  2344. begin
  2345. inherited Create;
  2346. fPixelSize := 2.0;
  2347. fRange.r := $FFFF;
  2348. fRange.g := $FFFF;
  2349. fRange.b := $FFFF;
  2350. fglFormat := GL_LUMINANCE;
  2351. fglDataFormat := GL_UNSIGNED_SHORT;
  2352. end;
  2353. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2354. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2355. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2356. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2357. var
  2358. i: Integer;
  2359. begin
  2360. PWord(aData)^ := 0;
  2361. for i := 0 to 3 do
  2362. if (fRange.arr[i] > 0) then
  2363. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2364. inc(aData, 2);
  2365. end;
  2366. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2367. var
  2368. i: Integer;
  2369. begin
  2370. for i := 0 to 3 do
  2371. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2372. inc(aData, 2);
  2373. end;
  2374. constructor TfdUniversal_US1.Create;
  2375. begin
  2376. inherited Create;
  2377. fPixelSize := 2.0;
  2378. end;
  2379. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2380. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2381. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2382. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2383. begin
  2384. PWord(aData)^ := DepthWeight(aPixel);
  2385. inc(aData, 2);
  2386. end;
  2387. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2388. begin
  2389. aPixel.Data.r := PWord(aData)^;
  2390. aPixel.Data.g := PWord(aData)^;
  2391. aPixel.Data.b := PWord(aData)^;
  2392. aPixel.Data.a := 0;
  2393. inc(aData, 2);
  2394. end;
  2395. constructor TfdDepth_US1.Create;
  2396. begin
  2397. inherited Create;
  2398. fPixelSize := 2.0;
  2399. fRange.r := $FFFF;
  2400. fRange.g := $FFFF;
  2401. fRange.b := $FFFF;
  2402. fglFormat := GL_DEPTH_COMPONENT;
  2403. fglDataFormat := GL_UNSIGNED_SHORT;
  2404. end;
  2405. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2406. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2407. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2408. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2409. begin
  2410. inherited Map(aPixel, aData, aMapData);
  2411. PWord(aData)^ := aPixel.Data.a;
  2412. inc(aData, 2);
  2413. end;
  2414. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2415. begin
  2416. inherited Unmap(aData, aPixel, aMapData);
  2417. aPixel.Data.a := PWord(aData)^;
  2418. inc(aData, 2);
  2419. end;
  2420. constructor TfdLuminanceAlpha_US2.Create;
  2421. begin
  2422. inherited Create;
  2423. fPixelSize := 4.0;
  2424. fRange.a := $FFFF;
  2425. fShift.a := 16;
  2426. fglFormat := GL_LUMINANCE_ALPHA;
  2427. fglDataFormat := GL_UNSIGNED_SHORT;
  2428. end;
  2429. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2430. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2431. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2432. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2433. begin
  2434. PWord(aData)^ := aPixel.Data.r;
  2435. inc(aData, 2);
  2436. PWord(aData)^ := aPixel.Data.g;
  2437. inc(aData, 2);
  2438. PWord(aData)^ := aPixel.Data.b;
  2439. inc(aData, 2);
  2440. end;
  2441. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2442. begin
  2443. aPixel.Data.r := PWord(aData)^;
  2444. inc(aData, 2);
  2445. aPixel.Data.g := PWord(aData)^;
  2446. inc(aData, 2);
  2447. aPixel.Data.b := PWord(aData)^;
  2448. inc(aData, 2);
  2449. aPixel.Data.a := 0;
  2450. end;
  2451. constructor TfdRGB_US3.Create;
  2452. begin
  2453. inherited Create;
  2454. fPixelSize := 6.0;
  2455. fRange.r := $FFFF;
  2456. fRange.g := $FFFF;
  2457. fRange.b := $FFFF;
  2458. fShift.r := 0;
  2459. fShift.g := 16;
  2460. fShift.b := 32;
  2461. fglFormat := GL_RGB;
  2462. fglDataFormat := GL_UNSIGNED_SHORT;
  2463. end;
  2464. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2465. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2466. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2467. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2468. begin
  2469. PWord(aData)^ := aPixel.Data.b;
  2470. inc(aData, 2);
  2471. PWord(aData)^ := aPixel.Data.g;
  2472. inc(aData, 2);
  2473. PWord(aData)^ := aPixel.Data.r;
  2474. inc(aData, 2);
  2475. end;
  2476. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2477. begin
  2478. aPixel.Data.b := PWord(aData)^;
  2479. inc(aData, 2);
  2480. aPixel.Data.g := PWord(aData)^;
  2481. inc(aData, 2);
  2482. aPixel.Data.r := PWord(aData)^;
  2483. inc(aData, 2);
  2484. aPixel.Data.a := 0;
  2485. end;
  2486. constructor TfdBGR_US3.Create;
  2487. begin
  2488. inherited Create;
  2489. fPixelSize := 6.0;
  2490. fRange.r := $FFFF;
  2491. fRange.g := $FFFF;
  2492. fRange.b := $FFFF;
  2493. fShift.r := 32;
  2494. fShift.g := 16;
  2495. fShift.b := 0;
  2496. fglFormat := GL_BGR;
  2497. fglDataFormat := GL_UNSIGNED_SHORT;
  2498. end;
  2499. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2500. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2501. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2502. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2503. begin
  2504. inherited Map(aPixel, aData, aMapData);
  2505. PWord(aData)^ := aPixel.Data.a;
  2506. inc(aData, 2);
  2507. end;
  2508. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2509. begin
  2510. inherited Unmap(aData, aPixel, aMapData);
  2511. aPixel.Data.a := PWord(aData)^;
  2512. inc(aData, 2);
  2513. end;
  2514. constructor TfdRGBA_US4.Create;
  2515. begin
  2516. inherited Create;
  2517. fPixelSize := 8.0;
  2518. fRange.a := $FFFF;
  2519. fShift.a := 48;
  2520. fglFormat := GL_RGBA;
  2521. fglDataFormat := GL_UNSIGNED_SHORT;
  2522. end;
  2523. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2524. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2525. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2526. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2527. begin
  2528. inherited Map(aPixel, aData, aMapData);
  2529. PWord(aData)^ := aPixel.Data.a;
  2530. inc(aData, 2);
  2531. end;
  2532. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2533. begin
  2534. inherited Unmap(aData, aPixel, aMapData);
  2535. aPixel.Data.a := PWord(aData)^;
  2536. inc(aData, 2);
  2537. end;
  2538. constructor TfdBGRA_US4.Create;
  2539. begin
  2540. inherited Create;
  2541. fPixelSize := 8.0;
  2542. fRange.a := $FFFF;
  2543. fShift.a := 48;
  2544. fglFormat := GL_BGRA;
  2545. fglDataFormat := GL_UNSIGNED_SHORT;
  2546. end;
  2547. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2548. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2549. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2550. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2551. var
  2552. i: Integer;
  2553. begin
  2554. PCardinal(aData)^ := 0;
  2555. for i := 0 to 3 do
  2556. if (fRange.arr[i] > 0) then
  2557. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2558. inc(aData, 4);
  2559. end;
  2560. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2561. var
  2562. i: Integer;
  2563. begin
  2564. for i := 0 to 3 do
  2565. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2566. inc(aData, 2);
  2567. end;
  2568. constructor TfdUniversal_UI1.Create;
  2569. begin
  2570. inherited Create;
  2571. fPixelSize := 4.0;
  2572. end;
  2573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2574. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2575. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2576. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2577. begin
  2578. PCardinal(aData)^ := DepthWeight(aPixel);
  2579. inc(aData, 4);
  2580. end;
  2581. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2582. begin
  2583. aPixel.Data.r := PCardinal(aData)^;
  2584. aPixel.Data.g := PCardinal(aData)^;
  2585. aPixel.Data.b := PCardinal(aData)^;
  2586. aPixel.Data.a := 0;
  2587. inc(aData, 4);
  2588. end;
  2589. constructor TfdDepth_UI1.Create;
  2590. begin
  2591. inherited Create;
  2592. fPixelSize := 4.0;
  2593. fRange.r := $FFFFFFFF;
  2594. fRange.g := $FFFFFFFF;
  2595. fRange.b := $FFFFFFFF;
  2596. fglFormat := GL_DEPTH_COMPONENT;
  2597. fglDataFormat := GL_UNSIGNED_INT;
  2598. end;
  2599. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2600. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2601. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2602. constructor TfdAlpha4.Create;
  2603. begin
  2604. inherited Create;
  2605. fFormat := tfAlpha4;
  2606. fWithAlpha := tfAlpha4;
  2607. fglInternalFormat := GL_ALPHA4;
  2608. end;
  2609. constructor TfdAlpha8.Create;
  2610. begin
  2611. inherited Create;
  2612. fFormat := tfAlpha8;
  2613. fWithAlpha := tfAlpha8;
  2614. fglInternalFormat := GL_ALPHA8;
  2615. end;
  2616. constructor TfdAlpha12.Create;
  2617. begin
  2618. inherited Create;
  2619. fFormat := tfAlpha12;
  2620. fWithAlpha := tfAlpha12;
  2621. fglInternalFormat := GL_ALPHA12;
  2622. end;
  2623. constructor TfdAlpha16.Create;
  2624. begin
  2625. inherited Create;
  2626. fFormat := tfAlpha16;
  2627. fWithAlpha := tfAlpha16;
  2628. fglInternalFormat := GL_ALPHA16;
  2629. end;
  2630. constructor TfdLuminance4.Create;
  2631. begin
  2632. inherited Create;
  2633. fFormat := tfLuminance4;
  2634. fWithAlpha := tfLuminance4Alpha4;
  2635. fWithoutAlpha := tfLuminance4;
  2636. fglInternalFormat := GL_LUMINANCE4;
  2637. end;
  2638. constructor TfdLuminance8.Create;
  2639. begin
  2640. inherited Create;
  2641. fFormat := tfLuminance8;
  2642. fWithAlpha := tfLuminance8Alpha8;
  2643. fWithoutAlpha := tfLuminance8;
  2644. fglInternalFormat := GL_LUMINANCE8;
  2645. end;
  2646. constructor TfdLuminance12.Create;
  2647. begin
  2648. inherited Create;
  2649. fFormat := tfLuminance12;
  2650. fWithAlpha := tfLuminance12Alpha12;
  2651. fWithoutAlpha := tfLuminance12;
  2652. fglInternalFormat := GL_LUMINANCE12;
  2653. end;
  2654. constructor TfdLuminance16.Create;
  2655. begin
  2656. inherited Create;
  2657. fFormat := tfLuminance16;
  2658. fWithAlpha := tfLuminance16Alpha16;
  2659. fWithoutAlpha := tfLuminance16;
  2660. fglInternalFormat := GL_LUMINANCE16;
  2661. end;
  2662. constructor TfdLuminance4Alpha4.Create;
  2663. begin
  2664. inherited Create;
  2665. fFormat := tfLuminance4Alpha4;
  2666. fWithAlpha := tfLuminance4Alpha4;
  2667. fWithoutAlpha := tfLuminance4;
  2668. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2669. end;
  2670. constructor TfdLuminance6Alpha2.Create;
  2671. begin
  2672. inherited Create;
  2673. fFormat := tfLuminance6Alpha2;
  2674. fWithAlpha := tfLuminance6Alpha2;
  2675. fWithoutAlpha := tfLuminance8;
  2676. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2677. end;
  2678. constructor TfdLuminance8Alpha8.Create;
  2679. begin
  2680. inherited Create;
  2681. fFormat := tfLuminance8Alpha8;
  2682. fWithAlpha := tfLuminance8Alpha8;
  2683. fWithoutAlpha := tfLuminance8;
  2684. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2685. end;
  2686. constructor TfdLuminance12Alpha4.Create;
  2687. begin
  2688. inherited Create;
  2689. fFormat := tfLuminance12Alpha4;
  2690. fWithAlpha := tfLuminance12Alpha4;
  2691. fWithoutAlpha := tfLuminance12;
  2692. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2693. end;
  2694. constructor TfdLuminance12Alpha12.Create;
  2695. begin
  2696. inherited Create;
  2697. fFormat := tfLuminance12Alpha12;
  2698. fWithAlpha := tfLuminance12Alpha12;
  2699. fWithoutAlpha := tfLuminance12;
  2700. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2701. end;
  2702. constructor TfdLuminance16Alpha16.Create;
  2703. begin
  2704. inherited Create;
  2705. fFormat := tfLuminance16Alpha16;
  2706. fWithAlpha := tfLuminance16Alpha16;
  2707. fWithoutAlpha := tfLuminance16;
  2708. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2709. end;
  2710. constructor TfdR3G3B2.Create;
  2711. begin
  2712. inherited Create;
  2713. fFormat := tfR3G3B2;
  2714. fWithAlpha := tfRGBA2;
  2715. fWithoutAlpha := tfR3G3B2;
  2716. fRange.r := $7;
  2717. fRange.g := $7;
  2718. fRange.b := $3;
  2719. fShift.r := 0;
  2720. fShift.g := 3;
  2721. fShift.b := 6;
  2722. fglFormat := GL_RGB;
  2723. fglInternalFormat := GL_R3_G3_B2;
  2724. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2725. end;
  2726. constructor TfdRGB4.Create;
  2727. begin
  2728. inherited Create;
  2729. fFormat := tfRGB4;
  2730. fWithAlpha := tfRGBA4;
  2731. fWithoutAlpha := tfRGB4;
  2732. fRGBInverted := tfBGR4;
  2733. fRange.r := $F;
  2734. fRange.g := $F;
  2735. fRange.b := $F;
  2736. fShift.r := 0;
  2737. fShift.g := 4;
  2738. fShift.b := 8;
  2739. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2740. fglInternalFormat := GL_RGB4;
  2741. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2742. end;
  2743. constructor TfdR5G6B5.Create;
  2744. begin
  2745. inherited Create;
  2746. fFormat := tfR5G6B5;
  2747. fWithAlpha := tfRGBA4;
  2748. fWithoutAlpha := tfR5G6B5;
  2749. fRGBInverted := tfB5G6R5;
  2750. fRange.r := $1F;
  2751. fRange.g := $3F;
  2752. fRange.b := $1F;
  2753. fShift.r := 0;
  2754. fShift.g := 5;
  2755. fShift.b := 11;
  2756. fglFormat := GL_RGB;
  2757. fglInternalFormat := GL_RGB565;
  2758. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2759. end;
  2760. constructor TfdRGB5.Create;
  2761. begin
  2762. inherited Create;
  2763. fFormat := tfRGB5;
  2764. fWithAlpha := tfRGB5A1;
  2765. fWithoutAlpha := tfRGB5;
  2766. fRGBInverted := tfBGR5;
  2767. fRange.r := $1F;
  2768. fRange.g := $1F;
  2769. fRange.b := $1F;
  2770. fShift.r := 0;
  2771. fShift.g := 5;
  2772. fShift.b := 10;
  2773. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2774. fglInternalFormat := GL_RGB5;
  2775. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2776. end;
  2777. constructor TfdRGB8.Create;
  2778. begin
  2779. inherited Create;
  2780. fFormat := tfRGB8;
  2781. fWithAlpha := tfRGBA8;
  2782. fWithoutAlpha := tfRGB8;
  2783. fRGBInverted := tfBGR8;
  2784. fglInternalFormat := GL_RGB8;
  2785. end;
  2786. constructor TfdRGB10.Create;
  2787. begin
  2788. inherited Create;
  2789. fFormat := tfRGB10;
  2790. fWithAlpha := tfRGB10A2;
  2791. fWithoutAlpha := tfRGB10;
  2792. fRGBInverted := tfBGR10;
  2793. fRange.r := $3FF;
  2794. fRange.g := $3FF;
  2795. fRange.b := $3FF;
  2796. fShift.r := 0;
  2797. fShift.g := 10;
  2798. fShift.b := 20;
  2799. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2800. fglInternalFormat := GL_RGB10;
  2801. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2802. end;
  2803. constructor TfdRGB12.Create;
  2804. begin
  2805. inherited Create;
  2806. fFormat := tfRGB12;
  2807. fWithAlpha := tfRGBA12;
  2808. fWithoutAlpha := tfRGB12;
  2809. fRGBInverted := tfBGR12;
  2810. fglInternalFormat := GL_RGB12;
  2811. end;
  2812. constructor TfdRGB16.Create;
  2813. begin
  2814. inherited Create;
  2815. fFormat := tfRGB16;
  2816. fWithAlpha := tfRGBA16;
  2817. fWithoutAlpha := tfRGB16;
  2818. fRGBInverted := tfBGR16;
  2819. fglInternalFormat := GL_RGB16;
  2820. end;
  2821. constructor TfdRGBA2.Create;
  2822. begin
  2823. inherited Create;
  2824. fFormat := tfRGBA2;
  2825. fWithAlpha := tfRGBA2;
  2826. fWithoutAlpha := tfR3G3B2;
  2827. fRGBInverted := tfBGRA2;
  2828. fglInternalFormat := GL_RGBA2;
  2829. end;
  2830. constructor TfdRGBA4.Create;
  2831. begin
  2832. inherited Create;
  2833. fFormat := tfRGBA4;
  2834. fWithAlpha := tfRGBA4;
  2835. fWithoutAlpha := tfRGB4;
  2836. fRGBInverted := tfBGRA4;
  2837. fRange.r := $F;
  2838. fRange.g := $F;
  2839. fRange.b := $F;
  2840. fRange.a := $F;
  2841. fShift.r := 0;
  2842. fShift.g := 4;
  2843. fShift.b := 8;
  2844. fShift.a := 12;
  2845. fglFormat := GL_RGBA;
  2846. fglInternalFormat := GL_RGBA4;
  2847. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2848. end;
  2849. constructor TfdRGB5A1.Create;
  2850. begin
  2851. inherited Create;
  2852. fFormat := tfRGB5A1;
  2853. fWithAlpha := tfRGB5A1;
  2854. fWithoutAlpha := tfRGB5;
  2855. fRGBInverted := tfBGR5A1;
  2856. fRange.r := $1F;
  2857. fRange.g := $1F;
  2858. fRange.b := $1F;
  2859. fRange.a := $01;
  2860. fShift.r := 0;
  2861. fShift.g := 5;
  2862. fShift.b := 10;
  2863. fShift.a := 15;
  2864. fglFormat := GL_RGBA;
  2865. fglInternalFormat := GL_RGB5_A1;
  2866. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2867. end;
  2868. constructor TfdRGBA8.Create;
  2869. begin
  2870. inherited Create;
  2871. fFormat := tfRGBA8;
  2872. fWithAlpha := tfRGBA8;
  2873. fWithoutAlpha := tfRGB8;
  2874. fRGBInverted := tfBGRA8;
  2875. fglInternalFormat := GL_RGBA8;
  2876. end;
  2877. constructor TfdRGB10A2.Create;
  2878. begin
  2879. inherited Create;
  2880. fFormat := tfRGB10A2;
  2881. fWithAlpha := tfRGB10A2;
  2882. fWithoutAlpha := tfRGB10;
  2883. fRGBInverted := tfBGR10A2;
  2884. fRange.r := $3FF;
  2885. fRange.g := $3FF;
  2886. fRange.b := $3FF;
  2887. fRange.a := $003;
  2888. fShift.r := 0;
  2889. fShift.g := 10;
  2890. fShift.b := 20;
  2891. fShift.a := 30;
  2892. fglFormat := GL_RGBA;
  2893. fglInternalFormat := GL_RGB10_A2;
  2894. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2895. end;
  2896. constructor TfdRGBA12.Create;
  2897. begin
  2898. inherited Create;
  2899. fFormat := tfRGBA12;
  2900. fWithAlpha := tfRGBA12;
  2901. fWithoutAlpha := tfRGB12;
  2902. fRGBInverted := tfBGRA12;
  2903. fglInternalFormat := GL_RGBA12;
  2904. end;
  2905. constructor TfdRGBA16.Create;
  2906. begin
  2907. inherited Create;
  2908. fFormat := tfRGBA16;
  2909. fWithAlpha := tfRGBA16;
  2910. fWithoutAlpha := tfRGB16;
  2911. fRGBInverted := tfBGRA16;
  2912. fglInternalFormat := GL_RGBA16;
  2913. end;
  2914. constructor TfdBGR4.Create;
  2915. begin
  2916. inherited Create;
  2917. fPixelSize := 2.0;
  2918. fFormat := tfBGR4;
  2919. fWithAlpha := tfBGRA4;
  2920. fWithoutAlpha := tfBGR4;
  2921. fRGBInverted := tfRGB4;
  2922. fRange.r := $F;
  2923. fRange.g := $F;
  2924. fRange.b := $F;
  2925. fRange.a := $0;
  2926. fShift.r := 8;
  2927. fShift.g := 4;
  2928. fShift.b := 0;
  2929. fShift.a := 0;
  2930. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2931. fglInternalFormat := GL_RGB4;
  2932. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2933. end;
  2934. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2935. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2936. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2937. constructor TfdB5G6R5.Create;
  2938. begin
  2939. inherited Create;
  2940. fFormat := tfB5G6R5;
  2941. fWithAlpha := tfBGRA4;
  2942. fWithoutAlpha := tfB5G6R5;
  2943. fRGBInverted := tfR5G6B5;
  2944. fRange.r := $1F;
  2945. fRange.g := $3F;
  2946. fRange.b := $1F;
  2947. fShift.r := 11;
  2948. fShift.g := 5;
  2949. fShift.b := 0;
  2950. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2951. fglInternalFormat := GL_RGB8;
  2952. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2953. end;
  2954. constructor TfdBGR5.Create;
  2955. begin
  2956. inherited Create;
  2957. fPixelSize := 2.0;
  2958. fFormat := tfBGR5;
  2959. fWithAlpha := tfBGR5A1;
  2960. fWithoutAlpha := tfBGR5;
  2961. fRGBInverted := tfRGB5;
  2962. fRange.r := $1F;
  2963. fRange.g := $1F;
  2964. fRange.b := $1F;
  2965. fRange.a := $00;
  2966. fShift.r := 10;
  2967. fShift.g := 5;
  2968. fShift.b := 0;
  2969. fShift.a := 0;
  2970. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2971. fglInternalFormat := GL_RGB5;
  2972. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2973. end;
  2974. constructor TfdBGR8.Create;
  2975. begin
  2976. inherited Create;
  2977. fFormat := tfBGR8;
  2978. fWithAlpha := tfBGRA8;
  2979. fWithoutAlpha := tfBGR8;
  2980. fRGBInverted := tfRGB8;
  2981. fglInternalFormat := GL_RGB8;
  2982. end;
  2983. constructor TfdBGR10.Create;
  2984. begin
  2985. inherited Create;
  2986. fFormat := tfBGR10;
  2987. fWithAlpha := tfBGR10A2;
  2988. fWithoutAlpha := tfBGR10;
  2989. fRGBInverted := tfRGB10;
  2990. fRange.r := $3FF;
  2991. fRange.g := $3FF;
  2992. fRange.b := $3FF;
  2993. fRange.a := $000;
  2994. fShift.r := 20;
  2995. fShift.g := 10;
  2996. fShift.b := 0;
  2997. fShift.a := 0;
  2998. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2999. fglInternalFormat := GL_RGB10;
  3000. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3001. end;
  3002. constructor TfdBGR12.Create;
  3003. begin
  3004. inherited Create;
  3005. fFormat := tfBGR12;
  3006. fWithAlpha := tfBGRA12;
  3007. fWithoutAlpha := tfBGR12;
  3008. fRGBInverted := tfRGB12;
  3009. fglInternalFormat := GL_RGB12;
  3010. end;
  3011. constructor TfdBGR16.Create;
  3012. begin
  3013. inherited Create;
  3014. fFormat := tfBGR16;
  3015. fWithAlpha := tfBGRA16;
  3016. fWithoutAlpha := tfBGR16;
  3017. fRGBInverted := tfRGB16;
  3018. fglInternalFormat := GL_RGB16;
  3019. end;
  3020. constructor TfdBGRA2.Create;
  3021. begin
  3022. inherited Create;
  3023. fFormat := tfBGRA2;
  3024. fWithAlpha := tfBGRA4;
  3025. fWithoutAlpha := tfBGR4;
  3026. fRGBInverted := tfRGBA2;
  3027. fglInternalFormat := GL_RGBA2;
  3028. end;
  3029. constructor TfdBGRA4.Create;
  3030. begin
  3031. inherited Create;
  3032. fFormat := tfBGRA4;
  3033. fWithAlpha := tfBGRA4;
  3034. fWithoutAlpha := tfBGR4;
  3035. fRGBInverted := tfRGBA4;
  3036. fRange.r := $F;
  3037. fRange.g := $F;
  3038. fRange.b := $F;
  3039. fRange.a := $F;
  3040. fShift.r := 8;
  3041. fShift.g := 4;
  3042. fShift.b := 0;
  3043. fShift.a := 12;
  3044. fglFormat := GL_BGRA;
  3045. fglInternalFormat := GL_RGBA4;
  3046. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3047. end;
  3048. constructor TfdBGR5A1.Create;
  3049. begin
  3050. inherited Create;
  3051. fFormat := tfBGR5A1;
  3052. fWithAlpha := tfBGR5A1;
  3053. fWithoutAlpha := tfBGR5;
  3054. fRGBInverted := tfRGB5A1;
  3055. fRange.r := $1F;
  3056. fRange.g := $1F;
  3057. fRange.b := $1F;
  3058. fRange.a := $01;
  3059. fShift.r := 10;
  3060. fShift.g := 5;
  3061. fShift.b := 0;
  3062. fShift.a := 15;
  3063. fglFormat := GL_BGRA;
  3064. fglInternalFormat := GL_RGB5_A1;
  3065. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3066. end;
  3067. constructor TfdBGRA8.Create;
  3068. begin
  3069. inherited Create;
  3070. fFormat := tfBGRA8;
  3071. fWithAlpha := tfBGRA8;
  3072. fWithoutAlpha := tfBGR8;
  3073. fRGBInverted := tfRGBA8;
  3074. fglInternalFormat := GL_RGBA8;
  3075. end;
  3076. constructor TfdBGR10A2.Create;
  3077. begin
  3078. inherited Create;
  3079. fFormat := tfBGR10A2;
  3080. fWithAlpha := tfBGR10A2;
  3081. fWithoutAlpha := tfBGR10;
  3082. fRGBInverted := tfRGB10A2;
  3083. fRange.r := $3FF;
  3084. fRange.g := $3FF;
  3085. fRange.b := $3FF;
  3086. fRange.a := $003;
  3087. fShift.r := 20;
  3088. fShift.g := 10;
  3089. fShift.b := 0;
  3090. fShift.a := 30;
  3091. fglFormat := GL_BGRA;
  3092. fglInternalFormat := GL_RGB10_A2;
  3093. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3094. end;
  3095. constructor TfdBGRA12.Create;
  3096. begin
  3097. inherited Create;
  3098. fFormat := tfBGRA12;
  3099. fWithAlpha := tfBGRA12;
  3100. fWithoutAlpha := tfBGR12;
  3101. fRGBInverted := tfRGBA12;
  3102. fglInternalFormat := GL_RGBA12;
  3103. end;
  3104. constructor TfdBGRA16.Create;
  3105. begin
  3106. inherited Create;
  3107. fFormat := tfBGRA16;
  3108. fWithAlpha := tfBGRA16;
  3109. fWithoutAlpha := tfBGR16;
  3110. fRGBInverted := tfRGBA16;
  3111. fglInternalFormat := GL_RGBA16;
  3112. end;
  3113. constructor TfdDepth16.Create;
  3114. begin
  3115. inherited Create;
  3116. fFormat := tfDepth16;
  3117. fWithAlpha := tfEmpty;
  3118. fWithoutAlpha := tfDepth16;
  3119. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3120. end;
  3121. constructor TfdDepth24.Create;
  3122. begin
  3123. inherited Create;
  3124. fFormat := tfDepth24;
  3125. fWithAlpha := tfEmpty;
  3126. fWithoutAlpha := tfDepth24;
  3127. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3128. end;
  3129. constructor TfdDepth32.Create;
  3130. begin
  3131. inherited Create;
  3132. fFormat := tfDepth32;
  3133. fWithAlpha := tfEmpty;
  3134. fWithoutAlpha := tfDepth32;
  3135. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3136. end;
  3137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3138. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3139. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3140. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3141. begin
  3142. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3143. end;
  3144. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3145. begin
  3146. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3147. end;
  3148. constructor TfdS3tcDtx1RGBA.Create;
  3149. begin
  3150. inherited Create;
  3151. fFormat := tfS3tcDtx1RGBA;
  3152. fWithAlpha := tfS3tcDtx1RGBA;
  3153. fUncompressed := tfRGB5A1;
  3154. fPixelSize := 0.5;
  3155. fIsCompressed := true;
  3156. fglFormat := GL_COMPRESSED_RGBA;
  3157. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3158. fglDataFormat := GL_UNSIGNED_BYTE;
  3159. end;
  3160. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3161. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3162. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3163. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3164. begin
  3165. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3166. end;
  3167. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3168. begin
  3169. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3170. end;
  3171. constructor TfdS3tcDtx3RGBA.Create;
  3172. begin
  3173. inherited Create;
  3174. fFormat := tfS3tcDtx3RGBA;
  3175. fWithAlpha := tfS3tcDtx3RGBA;
  3176. fUncompressed := tfRGBA8;
  3177. fPixelSize := 1.0;
  3178. fIsCompressed := true;
  3179. fglFormat := GL_COMPRESSED_RGBA;
  3180. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3181. fglDataFormat := GL_UNSIGNED_BYTE;
  3182. end;
  3183. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3184. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3186. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3187. begin
  3188. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3189. end;
  3190. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3191. begin
  3192. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3193. end;
  3194. constructor TfdS3tcDtx5RGBA.Create;
  3195. begin
  3196. inherited Create;
  3197. fFormat := tfS3tcDtx3RGBA;
  3198. fWithAlpha := tfS3tcDtx3RGBA;
  3199. fUncompressed := tfRGBA8;
  3200. fPixelSize := 1.0;
  3201. fIsCompressed := true;
  3202. fglFormat := GL_COMPRESSED_RGBA;
  3203. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3204. fglDataFormat := GL_UNSIGNED_BYTE;
  3205. end;
  3206. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3207. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3208. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3209. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3210. var
  3211. f: TglBitmapFormat;
  3212. begin
  3213. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3214. result := TFormatDescriptor.Get(f);
  3215. if (result.glInternalFormat = aInternalFormat) then
  3216. exit;
  3217. end;
  3218. result := TFormatDescriptor.Get(tfEmpty);
  3219. end;
  3220. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3221. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3223. class procedure TFormatDescriptor.Init;
  3224. begin
  3225. if not Assigned(FormatDescriptorCS) then
  3226. FormatDescriptorCS := TCriticalSection.Create;
  3227. end;
  3228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3229. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3230. begin
  3231. FormatDescriptorCS.Enter;
  3232. try
  3233. result := FormatDescriptors[aFormat];
  3234. if not Assigned(result) then begin
  3235. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3236. FormatDescriptors[aFormat] := result;
  3237. end;
  3238. finally
  3239. FormatDescriptorCS.Leave;
  3240. end;
  3241. end;
  3242. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3243. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3244. begin
  3245. result := Get(Get(aFormat).WithAlpha);
  3246. end;
  3247. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3248. class procedure TFormatDescriptor.Clear;
  3249. var
  3250. f: TglBitmapFormat;
  3251. begin
  3252. FormatDescriptorCS.Enter;
  3253. try
  3254. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3255. FreeAndNil(FormatDescriptors[f]);
  3256. finally
  3257. FormatDescriptorCS.Leave;
  3258. end;
  3259. end;
  3260. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3261. class procedure TFormatDescriptor.Finalize;
  3262. begin
  3263. Clear;
  3264. FreeAndNil(FormatDescriptorCS);
  3265. end;
  3266. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3267. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3268. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3269. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3270. begin
  3271. Update(aValue, fRange.r, fShift.r);
  3272. end;
  3273. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3274. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3275. begin
  3276. Update(aValue, fRange.g, fShift.g);
  3277. end;
  3278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3279. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3280. begin
  3281. Update(aValue, fRange.b, fShift.b);
  3282. end;
  3283. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3284. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3285. begin
  3286. Update(aValue, fRange.a, fShift.a);
  3287. end;
  3288. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3289. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3290. aShift: Byte);
  3291. begin
  3292. aShift := 0;
  3293. aRange := 0;
  3294. if (aMask = 0) then
  3295. exit;
  3296. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3297. inc(aShift);
  3298. aMask := aMask shr 1;
  3299. end;
  3300. aRange := 1;
  3301. while (aMask > 0) do begin
  3302. aRange := aRange shl 1;
  3303. aMask := aMask shr 1;
  3304. end;
  3305. dec(aRange);
  3306. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3307. end;
  3308. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3309. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3310. var
  3311. data: QWord;
  3312. s: Integer;
  3313. begin
  3314. data :=
  3315. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3316. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3317. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3318. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3319. s := Round(fPixelSize);
  3320. case s of
  3321. 1: aData^ := data;
  3322. 2: PWord(aData)^ := data;
  3323. 4: PCardinal(aData)^ := data;
  3324. 8: PQWord(aData)^ := data;
  3325. else
  3326. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3327. end;
  3328. inc(aData, s);
  3329. end;
  3330. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3331. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3332. var
  3333. data: QWord;
  3334. s, i: Integer;
  3335. begin
  3336. s := Round(fPixelSize);
  3337. case s of
  3338. 1: data := aData^;
  3339. 2: data := PWord(aData)^;
  3340. 4: data := PCardinal(aData)^;
  3341. 8: data := PQWord(aData)^;
  3342. else
  3343. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3344. end;
  3345. for i := 0 to 3 do
  3346. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3347. inc(aData, s);
  3348. end;
  3349. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3350. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3351. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3352. procedure TbmpColorTableFormat.CreateColorTable;
  3353. var
  3354. i: Integer;
  3355. begin
  3356. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3357. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3358. if (Format = tfLuminance4) then
  3359. SetLength(fColorTable, 16)
  3360. else
  3361. SetLength(fColorTable, 256);
  3362. case Format of
  3363. tfLuminance4: begin
  3364. for i := 0 to High(fColorTable) do begin
  3365. fColorTable[i].r := 16 * i;
  3366. fColorTable[i].g := 16 * i;
  3367. fColorTable[i].b := 16 * i;
  3368. fColorTable[i].a := 0;
  3369. end;
  3370. end;
  3371. tfLuminance8: begin
  3372. for i := 0 to High(fColorTable) do begin
  3373. fColorTable[i].r := i;
  3374. fColorTable[i].g := i;
  3375. fColorTable[i].b := i;
  3376. fColorTable[i].a := 0;
  3377. end;
  3378. end;
  3379. tfR3G3B2: begin
  3380. for i := 0 to High(fColorTable) do begin
  3381. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3382. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3383. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3384. fColorTable[i].a := 0;
  3385. end;
  3386. end;
  3387. end;
  3388. end;
  3389. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3390. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3391. var
  3392. d: Byte;
  3393. begin
  3394. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3395. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3396. case Format of
  3397. tfLuminance4: begin
  3398. if (aMapData = nil) then
  3399. aData^ := 0;
  3400. d := LuminanceWeight(aPixel) and Range.r;
  3401. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3402. inc(PByte(aMapData), 4);
  3403. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3404. inc(aData);
  3405. aMapData := nil;
  3406. end;
  3407. end;
  3408. tfLuminance8: begin
  3409. aData^ := LuminanceWeight(aPixel) and Range.r;
  3410. inc(aData);
  3411. end;
  3412. tfR3G3B2: begin
  3413. aData^ := Round(
  3414. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3415. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3416. ((aPixel.Data.b and Range.b) shl Shift.b));
  3417. inc(aData);
  3418. end;
  3419. end;
  3420. end;
  3421. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3422. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3423. var
  3424. idx: QWord;
  3425. s: Integer;
  3426. bits: Byte;
  3427. f: Single;
  3428. begin
  3429. s := Trunc(fPixelSize);
  3430. f := fPixelSize - s;
  3431. bits := Round(8 * f);
  3432. case s of
  3433. 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
  3434. 1: idx := aData^;
  3435. 2: idx := PWord(aData)^;
  3436. 4: idx := PCardinal(aData)^;
  3437. 8: idx := PQWord(aData)^;
  3438. else
  3439. raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3440. end;
  3441. if (idx >= Length(fColorTable)) then
  3442. raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
  3443. with fColorTable[idx] do begin
  3444. aPixel.Data.r := r;
  3445. aPixel.Data.g := g;
  3446. aPixel.Data.b := b;
  3447. aPixel.Data.a := a;
  3448. end;
  3449. inc(PByte(aMapData), bits);
  3450. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3451. inc(aData, 1);
  3452. dec(PByte(aMapData), 8);
  3453. end;
  3454. inc(aData, s);
  3455. end;
  3456. destructor TbmpColorTableFormat.Destroy;
  3457. begin
  3458. SetLength(fColorTable, 0);
  3459. inherited Destroy;
  3460. end;
  3461. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3462. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3464. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3465. var
  3466. i: Integer;
  3467. begin
  3468. for i := 0 to 3 do begin
  3469. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3470. if (aSourceFD.Range.arr[i] > 0) then
  3471. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3472. else
  3473. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3474. end;
  3475. end;
  3476. end;
  3477. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3478. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3479. begin
  3480. with aFuncRec do begin
  3481. if (Source.Range.r > 0) then
  3482. Dest.Data.r := Source.Data.r;
  3483. if (Source.Range.g > 0) then
  3484. Dest.Data.g := Source.Data.g;
  3485. if (Source.Range.b > 0) then
  3486. Dest.Data.b := Source.Data.b;
  3487. if (Source.Range.a > 0) then
  3488. Dest.Data.a := Source.Data.a;
  3489. end;
  3490. end;
  3491. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3492. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3493. var
  3494. i: Integer;
  3495. begin
  3496. with aFuncRec do begin
  3497. for i := 0 to 3 do
  3498. if (Source.Range.arr[i] > 0) then
  3499. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3500. end;
  3501. end;
  3502. type
  3503. TShiftData = packed record
  3504. case Integer of
  3505. 0: (r, g, b, a: SmallInt);
  3506. 1: (arr: array[0..3] of SmallInt);
  3507. end;
  3508. PShiftData = ^TShiftData;
  3509. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3510. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3511. var
  3512. i: Integer;
  3513. begin
  3514. with aFuncRec do
  3515. for i := 0 to 3 do
  3516. if (Source.Range.arr[i] > 0) then
  3517. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3518. end;
  3519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3520. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3521. begin
  3522. with aFuncRec do begin
  3523. Dest.Data := Source.Data;
  3524. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3525. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3526. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3527. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3528. end;
  3529. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3530. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3531. end;
  3532. end;
  3533. end;
  3534. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3535. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3536. var
  3537. i: Integer;
  3538. begin
  3539. with aFuncRec do begin
  3540. for i := 0 to 3 do
  3541. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3542. end;
  3543. end;
  3544. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3545. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3546. var
  3547. Temp: Single;
  3548. begin
  3549. with FuncRec do begin
  3550. if (FuncRec.Args = nil) then begin //source has no alpha
  3551. Temp :=
  3552. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3553. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3554. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3555. Dest.Data.a := Round(Dest.Range.a * Temp);
  3556. end else
  3557. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3558. end;
  3559. end;
  3560. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3561. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3562. type
  3563. PglBitmapPixelData = ^TglBitmapPixelData;
  3564. begin
  3565. with FuncRec do begin
  3566. Dest.Data.r := Source.Data.r;
  3567. Dest.Data.g := Source.Data.g;
  3568. Dest.Data.b := Source.Data.b;
  3569. with PglBitmapPixelData(Args)^ do
  3570. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3571. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3572. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3573. Dest.Data.a := 0
  3574. else
  3575. Dest.Data.a := Dest.Range.a;
  3576. end;
  3577. end;
  3578. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3579. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3580. begin
  3581. with FuncRec do begin
  3582. Dest.Data.r := Source.Data.r;
  3583. Dest.Data.g := Source.Data.g;
  3584. Dest.Data.b := Source.Data.b;
  3585. Dest.Data.a := PCardinal(Args)^;
  3586. end;
  3587. end;
  3588. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3589. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3590. type
  3591. PRGBPix = ^TRGBPix;
  3592. TRGBPix = array [0..2] of byte;
  3593. var
  3594. Temp: Byte;
  3595. begin
  3596. while aWidth > 0 do begin
  3597. Temp := PRGBPix(aData)^[0];
  3598. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3599. PRGBPix(aData)^[2] := Temp;
  3600. if aHasAlpha then
  3601. Inc(aData, 4)
  3602. else
  3603. Inc(aData, 3);
  3604. dec(aWidth);
  3605. end;
  3606. end;
  3607. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3608. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3609. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3610. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  3611. begin
  3612. result := TFormatDescriptor.Get(Format);
  3613. end;
  3614. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3615. function TglBitmap.GetWidth: Integer;
  3616. begin
  3617. if (ffX in fDimension.Fields) then
  3618. result := fDimension.X
  3619. else
  3620. result := -1;
  3621. end;
  3622. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3623. function TglBitmap.GetHeight: Integer;
  3624. begin
  3625. if (ffY in fDimension.Fields) then
  3626. result := fDimension.Y
  3627. else
  3628. result := -1;
  3629. end;
  3630. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3631. function TglBitmap.GetFileWidth: Integer;
  3632. begin
  3633. result := Max(1, Width);
  3634. end;
  3635. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3636. function TglBitmap.GetFileHeight: Integer;
  3637. begin
  3638. result := Max(1, Height);
  3639. end;
  3640. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3641. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3642. begin
  3643. if fCustomData = aValue then
  3644. exit;
  3645. fCustomData := aValue;
  3646. end;
  3647. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3648. procedure TglBitmap.SetCustomName(const aValue: String);
  3649. begin
  3650. if fCustomName = aValue then
  3651. exit;
  3652. fCustomName := aValue;
  3653. end;
  3654. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3655. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3656. begin
  3657. if fCustomNameW = aValue then
  3658. exit;
  3659. fCustomNameW := aValue;
  3660. end;
  3661. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3662. procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
  3663. begin
  3664. if fFreeDataOnDestroy = aValue then
  3665. exit;
  3666. fFreeDataOnDestroy := aValue;
  3667. end;
  3668. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3669. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3670. begin
  3671. if fDeleteTextureOnFree = aValue then
  3672. exit;
  3673. fDeleteTextureOnFree := aValue;
  3674. end;
  3675. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3676. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3677. begin
  3678. if fFormat = aValue then
  3679. exit;
  3680. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3681. raise EglBitmapUnsupportedFormat.Create(Format);
  3682. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  3683. end;
  3684. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3685. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3686. begin
  3687. if fFreeDataAfterGenTexture = aValue then
  3688. exit;
  3689. fFreeDataAfterGenTexture := aValue;
  3690. end;
  3691. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3692. procedure TglBitmap.SetID(const aValue: Cardinal);
  3693. begin
  3694. if fID = aValue then
  3695. exit;
  3696. fID := aValue;
  3697. end;
  3698. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3699. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3700. begin
  3701. if fMipMap = aValue then
  3702. exit;
  3703. fMipMap := aValue;
  3704. end;
  3705. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3706. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3707. begin
  3708. if fTarget = aValue then
  3709. exit;
  3710. fTarget := aValue;
  3711. end;
  3712. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3713. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3714. var
  3715. MaxAnisotropic: Integer;
  3716. begin
  3717. fAnisotropic := aValue;
  3718. if (ID > 0) then begin
  3719. if GL_EXT_texture_filter_anisotropic then begin
  3720. if fAnisotropic > 0 then begin
  3721. Bind(false);
  3722. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3723. if aValue > MaxAnisotropic then
  3724. fAnisotropic := MaxAnisotropic;
  3725. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3726. end;
  3727. end else begin
  3728. fAnisotropic := 0;
  3729. end;
  3730. end;
  3731. end;
  3732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3733. procedure TglBitmap.CreateID;
  3734. begin
  3735. if (ID <> 0) then
  3736. glDeleteTextures(1, @fID);
  3737. glGenTextures(1, @fID);
  3738. Bind(false);
  3739. end;
  3740. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3741. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3742. begin
  3743. // Set Up Parameters
  3744. SetWrap(fWrapS, fWrapT, fWrapR);
  3745. SetFilter(fFilterMin, fFilterMag);
  3746. SetAnisotropic(fAnisotropic);
  3747. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3748. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  3749. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3750. // Mip Maps Generation Mode
  3751. aBuildWithGlu := false;
  3752. if (MipMap = mmMipmap) then begin
  3753. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3754. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3755. else
  3756. aBuildWithGlu := true;
  3757. end else if (MipMap = mmMipmapGlu) then
  3758. aBuildWithGlu := true;
  3759. end;
  3760. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3761. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  3762. const aWidth: Integer; const aHeight: Integer);
  3763. var
  3764. s: Single;
  3765. begin
  3766. if (Data <> aData) then begin
  3767. if (Assigned(Data)) then
  3768. FreeMem(Data);
  3769. fData := aData;
  3770. end;
  3771. if not Assigned(fData) then begin
  3772. fPixelSize := 0;
  3773. fRowSize := 0;
  3774. end else begin
  3775. FillChar(fDimension, SizeOf(fDimension), 0);
  3776. if aWidth <> -1 then begin
  3777. fDimension.Fields := fDimension.Fields + [ffX];
  3778. fDimension.X := aWidth;
  3779. end;
  3780. if aHeight <> -1 then begin
  3781. fDimension.Fields := fDimension.Fields + [ffY];
  3782. fDimension.Y := aHeight;
  3783. end;
  3784. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3785. fFormat := aFormat;
  3786. fPixelSize := Ceil(s);
  3787. fRowSize := Ceil(s * aWidth);
  3788. end;
  3789. end;
  3790. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3791. function TglBitmap.FlipHorz: Boolean;
  3792. begin
  3793. result := false;
  3794. end;
  3795. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3796. function TglBitmap.FlipVert: Boolean;
  3797. begin
  3798. result := false;
  3799. end;
  3800. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3801. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3802. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3803. procedure TglBitmap.AfterConstruction;
  3804. begin
  3805. inherited AfterConstruction;
  3806. fID := 0;
  3807. fTarget := 0;
  3808. fIsResident := false;
  3809. fMipMap := glBitmapDefaultMipmap;
  3810. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3811. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3812. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3813. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3814. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3815. end;
  3816. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3817. procedure TglBitmap.BeforeDestruction;
  3818. var
  3819. NewData: PByte;
  3820. begin
  3821. if fFreeDataOnDestroy then begin
  3822. NewData := nil;
  3823. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  3824. end;
  3825. if (fID > 0) and fDeleteTextureOnFree then
  3826. glDeleteTextures(1, @fID);
  3827. inherited BeforeDestruction;
  3828. end;
  3829. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3830. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  3831. var
  3832. TempPos: Integer;
  3833. begin
  3834. if not Assigned(aResType) then begin
  3835. TempPos := Pos('.', aResource);
  3836. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3837. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3838. end;
  3839. end;
  3840. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3841. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3842. var
  3843. fs: TFileStream;
  3844. begin
  3845. if not FileExists(aFilename) then
  3846. raise EglBitmap.Create('file does not exist: ' + aFilename);
  3847. fFilename := aFilename;
  3848. fs := TFileStream.Create(fFilename, fmOpenRead);
  3849. try
  3850. fs.Position := 0;
  3851. LoadFromStream(fs);
  3852. finally
  3853. fs.Free;
  3854. end;
  3855. end;
  3856. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3857. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3858. begin
  3859. {$IFDEF GLB_SUPPORT_PNG_READ}
  3860. if not LoadPNG(aStream) then
  3861. {$ENDIF}
  3862. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3863. if not LoadJPEG(aStream) then
  3864. {$ENDIF}
  3865. if not LoadDDS(aStream) then
  3866. if not LoadTGA(aStream) then
  3867. if not LoadBMP(aStream) then
  3868. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3869. end;
  3870. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3871. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3872. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3873. var
  3874. tmpData: PByte;
  3875. size: Integer;
  3876. begin
  3877. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3878. GetMem(tmpData, size);
  3879. try
  3880. FillChar(tmpData^, size, #$FF);
  3881. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  3882. except
  3883. if Assigned(tmpData) then
  3884. FreeMem(tmpData);
  3885. raise;
  3886. end;
  3887. AddFunc(Self, aFunc, false, aFormat, aArgs);
  3888. end;
  3889. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3890. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  3891. var
  3892. rs: TResourceStream;
  3893. begin
  3894. PrepareResType(aResource, aResType);
  3895. rs := TResourceStream.Create(aInstance, aResource, aResType);
  3896. try
  3897. LoadFromStream(rs);
  3898. finally
  3899. rs.Free;
  3900. end;
  3901. end;
  3902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3903. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3904. var
  3905. rs: TResourceStream;
  3906. begin
  3907. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  3908. try
  3909. LoadFromStream(rs);
  3910. finally
  3911. rs.Free;
  3912. end;
  3913. end;
  3914. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3915. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3916. var
  3917. fs: TFileStream;
  3918. begin
  3919. fs := TFileStream.Create(aFileName, fmCreate);
  3920. try
  3921. fs.Position := 0;
  3922. SaveToStream(fs, aFileType);
  3923. finally
  3924. fs.Free;
  3925. end;
  3926. end;
  3927. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3928. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3929. begin
  3930. case aFileType of
  3931. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3932. ftPNG: SavePNG(aStream);
  3933. {$ENDIF}
  3934. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3935. ftJPEG: SaveJPEG(aStream);
  3936. {$ENDIF}
  3937. ftDDS: SaveDDS(aStream);
  3938. ftTGA: SaveTGA(aStream);
  3939. ftBMP: SaveBMP(aStream);
  3940. end;
  3941. end;
  3942. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3943. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3944. begin
  3945. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3946. end;
  3947. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3948. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3949. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3950. var
  3951. DestData, TmpData, SourceData: pByte;
  3952. TempHeight, TempWidth: Integer;
  3953. SourceFD, DestFD: TFormatDescriptor;
  3954. SourceMD, DestMD: Pointer;
  3955. FuncRec: TglBitmapFunctionRec;
  3956. begin
  3957. Assert(Assigned(Data));
  3958. Assert(Assigned(aSource));
  3959. Assert(Assigned(aSource.Data));
  3960. result := false;
  3961. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3962. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3963. DestFD := TFormatDescriptor.Get(aFormat);
  3964. if (SourceFD.IsCompressed) then
  3965. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  3966. if (DestFD.IsCompressed) then
  3967. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  3968. // inkompatible Formats so CreateTemp
  3969. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3970. aCreateTemp := true;
  3971. // Values
  3972. TempHeight := Max(1, aSource.Height);
  3973. TempWidth := Max(1, aSource.Width);
  3974. FuncRec.Sender := Self;
  3975. FuncRec.Args := aArgs;
  3976. TmpData := nil;
  3977. if aCreateTemp then begin
  3978. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  3979. DestData := TmpData;
  3980. end else
  3981. DestData := Data;
  3982. try
  3983. SourceFD.PreparePixel(FuncRec.Source);
  3984. DestFD.PreparePixel (FuncRec.Dest);
  3985. SourceMD := SourceFD.CreateMappingData;
  3986. DestMD := DestFD.CreateMappingData;
  3987. FuncRec.Size := aSource.Dimension;
  3988. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3989. try
  3990. SourceData := aSource.Data;
  3991. FuncRec.Position.Y := 0;
  3992. while FuncRec.Position.Y < TempHeight do begin
  3993. FuncRec.Position.X := 0;
  3994. while FuncRec.Position.X < TempWidth do begin
  3995. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3996. aFunc(FuncRec);
  3997. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3998. inc(FuncRec.Position.X);
  3999. end;
  4000. inc(FuncRec.Position.Y);
  4001. end;
  4002. // Updating Image or InternalFormat
  4003. if aCreateTemp then
  4004. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  4005. else if (aFormat <> fFormat) then
  4006. Format := aFormat;
  4007. result := true;
  4008. finally
  4009. SourceFD.FreeMappingData(SourceMD);
  4010. DestFD.FreeMappingData(DestMD);
  4011. end;
  4012. except
  4013. if aCreateTemp and Assigned(TmpData) then
  4014. FreeMem(TmpData);
  4015. raise;
  4016. end;
  4017. end;
  4018. end;
  4019. {$IFDEF GLB_SDL}
  4020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4021. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  4022. var
  4023. Row, RowSize: Integer;
  4024. SourceData, TmpData: PByte;
  4025. TempDepth: Integer;
  4026. FormatDesc: TFormatDescriptor;
  4027. function GetRowPointer(Row: Integer): pByte;
  4028. begin
  4029. result := aSurface.pixels;
  4030. Inc(result, Row * RowSize);
  4031. end;
  4032. begin
  4033. result := false;
  4034. FormatDesc := TFormatDescriptor.Get(Format);
  4035. if FormatDesc.IsCompressed then
  4036. raise EglBitmapUnsupportedFormat.Create(Format);
  4037. if Assigned(Data) then begin
  4038. case Trunc(FormatDesc.PixelSize) of
  4039. 1: TempDepth := 8;
  4040. 2: TempDepth := 16;
  4041. 3: TempDepth := 24;
  4042. 4: TempDepth := 32;
  4043. else
  4044. raise EglBitmapUnsupportedFormat.Create(Format);
  4045. end;
  4046. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4047. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4048. SourceData := Data;
  4049. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4050. for Row := 0 to FileHeight-1 do begin
  4051. TmpData := GetRowPointer(Row);
  4052. if Assigned(TmpData) then begin
  4053. Move(SourceData^, TmpData^, RowSize);
  4054. inc(SourceData, RowSize);
  4055. end;
  4056. end;
  4057. result := true;
  4058. end;
  4059. end;
  4060. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4061. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4062. var
  4063. pSource, pData, pTempData: PByte;
  4064. Row, RowSize, TempWidth, TempHeight: Integer;
  4065. IntFormat: TglBitmapFormat;
  4066. FormatDesc: TFormatDescriptor;
  4067. function GetRowPointer(Row: Integer): pByte;
  4068. begin
  4069. result := aSurface^.pixels;
  4070. Inc(result, Row * RowSize);
  4071. end;
  4072. begin
  4073. result := false;
  4074. if (Assigned(aSurface)) then begin
  4075. with aSurface^.format^ do begin
  4076. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  4077. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4078. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  4079. break;
  4080. end;
  4081. if (IntFormat = tfEmpty) then
  4082. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  4083. end;
  4084. TempWidth := aSurface^.w;
  4085. TempHeight := aSurface^.h;
  4086. RowSize := FormatDesc.GetSize(TempWidth, 1);
  4087. GetMem(pData, TempHeight * RowSize);
  4088. try
  4089. pTempData := pData;
  4090. for Row := 0 to TempHeight -1 do begin
  4091. pSource := GetRowPointer(Row);
  4092. if (Assigned(pSource)) then begin
  4093. Move(pSource^, pTempData^, RowSize);
  4094. Inc(pTempData, RowSize);
  4095. end;
  4096. end;
  4097. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4098. result := true;
  4099. except
  4100. if Assigned(pData) then
  4101. FreeMem(pData);
  4102. raise;
  4103. end;
  4104. end;
  4105. end;
  4106. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4107. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4108. var
  4109. Row, Col, AlphaInterleave: Integer;
  4110. pSource, pDest: PByte;
  4111. function GetRowPointer(Row: Integer): pByte;
  4112. begin
  4113. result := aSurface.pixels;
  4114. Inc(result, Row * Width);
  4115. end;
  4116. begin
  4117. result := false;
  4118. if Assigned(Data) then begin
  4119. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  4120. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4121. AlphaInterleave := 0;
  4122. case Format of
  4123. tfLuminance8Alpha8:
  4124. AlphaInterleave := 1;
  4125. tfBGRA8, tfRGBA8:
  4126. AlphaInterleave := 3;
  4127. end;
  4128. pSource := Data;
  4129. for Row := 0 to Height -1 do begin
  4130. pDest := GetRowPointer(Row);
  4131. if Assigned(pDest) then begin
  4132. for Col := 0 to Width -1 do begin
  4133. Inc(pSource, AlphaInterleave);
  4134. pDest^ := pSource^;
  4135. Inc(pDest);
  4136. Inc(pSource);
  4137. end;
  4138. end;
  4139. end;
  4140. result := true;
  4141. end;
  4142. end;
  4143. end;
  4144. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4145. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4146. var
  4147. bmp: TglBitmap2D;
  4148. begin
  4149. bmp := TglBitmap2D.Create;
  4150. try
  4151. bmp.AssignFromSurface(aSurface);
  4152. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4153. finally
  4154. bmp.Free;
  4155. end;
  4156. end;
  4157. {$ENDIF}
  4158. {$IFDEF GLB_DELPHI}
  4159. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4160. function CreateGrayPalette: HPALETTE;
  4161. var
  4162. Idx: Integer;
  4163. Pal: PLogPalette;
  4164. begin
  4165. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4166. Pal.palVersion := $300;
  4167. Pal.palNumEntries := 256;
  4168. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4169. Pal.palPalEntry[Idx].peRed := Idx;
  4170. Pal.palPalEntry[Idx].peGreen := Idx;
  4171. Pal.palPalEntry[Idx].peBlue := Idx;
  4172. Pal.palPalEntry[Idx].peFlags := 0;
  4173. end;
  4174. Result := CreatePalette(Pal^);
  4175. FreeMem(Pal);
  4176. end;
  4177. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4178. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4179. var
  4180. Row: Integer;
  4181. pSource, pData: PByte;
  4182. begin
  4183. result := false;
  4184. if Assigned(Data) then begin
  4185. if Assigned(aBitmap) then begin
  4186. aBitmap.Width := Width;
  4187. aBitmap.Height := Height;
  4188. case Format of
  4189. tfAlpha8, tfLuminance8: begin
  4190. aBitmap.PixelFormat := pf8bit;
  4191. aBitmap.Palette := CreateGrayPalette;
  4192. end;
  4193. tfRGB5A1:
  4194. aBitmap.PixelFormat := pf15bit;
  4195. tfR5G6B5:
  4196. aBitmap.PixelFormat := pf16bit;
  4197. tfRGB8, tfBGR8:
  4198. aBitmap.PixelFormat := pf24bit;
  4199. tfRGBA8, tfBGRA8:
  4200. aBitmap.PixelFormat := pf32bit;
  4201. else
  4202. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4203. end;
  4204. pSource := Data;
  4205. for Row := 0 to FileHeight -1 do begin
  4206. pData := aBitmap.Scanline[Row];
  4207. Move(pSource^, pData^, fRowSize);
  4208. Inc(pSource, fRowSize);
  4209. if (Format in [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A)
  4210. SwapRGB(pData, FileWidth, Format = tfRGBA8);
  4211. end;
  4212. result := true;
  4213. end;
  4214. end;
  4215. end;
  4216. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4217. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4218. var
  4219. pSource, pData, pTempData: PByte;
  4220. Row, RowSize, TempWidth, TempHeight: Integer;
  4221. IntFormat: TglBitmapFormat;
  4222. begin
  4223. result := false;
  4224. if (Assigned(aBitmap)) then begin
  4225. case aBitmap.PixelFormat of
  4226. pf8bit:
  4227. IntFormat := tfLuminance8;
  4228. pf15bit:
  4229. IntFormat := tfRGB5A1;
  4230. pf16bit:
  4231. IntFormat := tfR5G6B5;
  4232. pf24bit:
  4233. IntFormat := tfBGR8;
  4234. pf32bit:
  4235. IntFormat := tfBGRA8;
  4236. else
  4237. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4238. end;
  4239. TempWidth := aBitmap.Width;
  4240. TempHeight := aBitmap.Height;
  4241. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4242. GetMem(pData, TempHeight * RowSize);
  4243. try
  4244. pTempData := pData;
  4245. for Row := 0 to TempHeight -1 do begin
  4246. pSource := aBitmap.Scanline[Row];
  4247. if (Assigned(pSource)) then begin
  4248. Move(pSource^, pTempData^, RowSize);
  4249. Inc(pTempData, RowSize);
  4250. end;
  4251. end;
  4252. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4253. result := true;
  4254. except
  4255. if Assigned(pData) then
  4256. FreeMem(pData);
  4257. raise;
  4258. end;
  4259. end;
  4260. end;
  4261. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4262. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4263. var
  4264. Row, Col, AlphaInterleave: Integer;
  4265. pSource, pDest: PByte;
  4266. begin
  4267. result := false;
  4268. if Assigned(Data) then begin
  4269. if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
  4270. if Assigned(aBitmap) then begin
  4271. aBitmap.PixelFormat := pf8bit;
  4272. aBitmap.Palette := CreateGrayPalette;
  4273. aBitmap.Width := Width;
  4274. aBitmap.Height := Height;
  4275. case Format of
  4276. tfLuminance8Alpha8:
  4277. AlphaInterleave := 1;
  4278. tfRGBA8, tfBGRA8:
  4279. AlphaInterleave := 3;
  4280. else
  4281. AlphaInterleave := 0;
  4282. end;
  4283. // Copy Data
  4284. pSource := Data;
  4285. for Row := 0 to Height -1 do begin
  4286. pDest := aBitmap.Scanline[Row];
  4287. if Assigned(pDest) then begin
  4288. for Col := 0 to Width -1 do begin
  4289. Inc(pSource, AlphaInterleave);
  4290. pDest^ := pSource^;
  4291. Inc(pDest);
  4292. Inc(pSource);
  4293. end;
  4294. end;
  4295. end;
  4296. result := true;
  4297. end;
  4298. end;
  4299. end;
  4300. end;
  4301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4302. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4303. var
  4304. tex: TglBitmap2D;
  4305. begin
  4306. tex := TglBitmap2D.Create;
  4307. try
  4308. tex.AssignFromBitmap(ABitmap);
  4309. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4310. finally
  4311. tex.Free;
  4312. end;
  4313. end;
  4314. {$ENDIF}
  4315. {$IFDEF GLB_LAZARUS}
  4316. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4317. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4318. var
  4319. rid: TRawImageDescription;
  4320. FormatDesc: TFormatDescriptor;
  4321. begin
  4322. result := false;
  4323. if not Assigned(aImage) or (Format = tfEmpty) then
  4324. exit;
  4325. FormatDesc := TFormatDescriptor.Get(Format);
  4326. if FormatDesc.IsCompressed then
  4327. exit;
  4328. FillChar(rid{%H-}, SizeOf(rid), 0);
  4329. if (Format in [
  4330. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  4331. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  4332. tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
  4333. rid.Format := ricfGray
  4334. else
  4335. rid.Format := ricfRGBA;
  4336. rid.Width := Width;
  4337. rid.Height := Height;
  4338. rid.Depth := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
  4339. rid.BitOrder := riboBitsInOrder;
  4340. rid.ByteOrder := riboLSBFirst;
  4341. rid.LineOrder := riloTopToBottom;
  4342. rid.LineEnd := rileTight;
  4343. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4344. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4345. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4346. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4347. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4348. rid.RedShift := FormatDesc.Shift.r;
  4349. rid.GreenShift := FormatDesc.Shift.g;
  4350. rid.BlueShift := FormatDesc.Shift.b;
  4351. rid.AlphaShift := FormatDesc.Shift.a;
  4352. rid.MaskBitsPerPixel := 0;
  4353. rid.PaletteColorCount := 0;
  4354. aImage.DataDescription := rid;
  4355. aImage.CreateData;
  4356. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4357. result := true;
  4358. end;
  4359. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4360. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4361. var
  4362. f: TglBitmapFormat;
  4363. FormatDesc: TFormatDescriptor;
  4364. ImageData: PByte;
  4365. ImageSize: Integer;
  4366. CanCopy: Boolean;
  4367. procedure CopyConvert;
  4368. var
  4369. bfFormat: TbmpBitfieldFormat;
  4370. pSourceLine, pDestLine: PByte;
  4371. pSourceMD, pDestMD: Pointer;
  4372. x, y: Integer;
  4373. pixel: TglBitmapPixelData;
  4374. begin
  4375. bfFormat := TbmpBitfieldFormat.Create;
  4376. with aImage.DataDescription do begin
  4377. bfFormat.RedMask := ((1 shl RedPrec) - 1) shl RedShift;
  4378. bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
  4379. bfFormat.BlueMask := ((1 shl BluePrec) - 1) shl BlueShift;
  4380. bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
  4381. bfFormat.PixelSize := BitsPerPixel / 8;
  4382. end;
  4383. pSourceMD := bfFormat.CreateMappingData;
  4384. pDestMD := FormatDesc.CreateMappingData;
  4385. try
  4386. for y := 0 to aImage.Height-1 do begin
  4387. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  4388. pDestLine := ImageData + y * Round(FormatDesc.PixelSize * aImage.Width);
  4389. for x := 0 to aImage.Width-1 do begin
  4390. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  4391. FormatDesc.Map(pixel, pDestLine, pDestMD);
  4392. end;
  4393. end;
  4394. finally
  4395. FormatDesc.FreeMappingData(pDestMD);
  4396. bfFormat.FreeMappingData(pSourceMD);
  4397. bfFormat.Free;
  4398. end;
  4399. end;
  4400. begin
  4401. result := false;
  4402. if not Assigned(aImage) then
  4403. exit;
  4404. for f := High(f) downto Low(f) do begin
  4405. FormatDesc := TFormatDescriptor.Get(f);
  4406. with aImage.DataDescription do
  4407. if FormatDesc.MaskMatch(
  4408. (QWord(1 shl RedPrec )-1) shl RedShift,
  4409. (QWord(1 shl GreenPrec)-1) shl GreenShift,
  4410. (QWord(1 shl BluePrec )-1) shl BlueShift,
  4411. (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
  4412. break;
  4413. end;
  4414. if (f = tfEmpty) then
  4415. exit;
  4416. CanCopy :=
  4417. (Round(FormatDesc.PixelSize * 8) = aImage.DataDescription.Depth) and
  4418. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  4419. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4420. ImageData := GetMem(ImageSize);
  4421. try
  4422. if CanCopy then
  4423. Move(aImage.PixelData^, ImageData^, ImageSize)
  4424. else
  4425. CopyConvert;
  4426. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4427. except
  4428. if Assigned(ImageData) then
  4429. FreeMem(ImageData);
  4430. raise;
  4431. end;
  4432. result := true;
  4433. end;
  4434. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4435. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4436. var
  4437. rid: TRawImageDescription;
  4438. FormatDesc: TFormatDescriptor;
  4439. Pixel: TglBitmapPixelData;
  4440. x, y: Integer;
  4441. srcMD: Pointer;
  4442. src, dst: PByte;
  4443. begin
  4444. result := false;
  4445. if not Assigned(aImage) or (Format = tfEmpty) then
  4446. exit;
  4447. FormatDesc := TFormatDescriptor.Get(Format);
  4448. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4449. exit;
  4450. FillChar(rid{%H-}, SizeOf(rid), 0);
  4451. rid.Format := ricfGray;
  4452. rid.Width := Width;
  4453. rid.Height := Height;
  4454. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4455. rid.BitOrder := riboBitsInOrder;
  4456. rid.ByteOrder := riboLSBFirst;
  4457. rid.LineOrder := riloTopToBottom;
  4458. rid.LineEnd := rileTight;
  4459. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4460. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4461. rid.GreenPrec := 0;
  4462. rid.BluePrec := 0;
  4463. rid.AlphaPrec := 0;
  4464. rid.RedShift := 0;
  4465. rid.GreenShift := 0;
  4466. rid.BlueShift := 0;
  4467. rid.AlphaShift := 0;
  4468. rid.MaskBitsPerPixel := 0;
  4469. rid.PaletteColorCount := 0;
  4470. aImage.DataDescription := rid;
  4471. aImage.CreateData;
  4472. srcMD := FormatDesc.CreateMappingData;
  4473. try
  4474. FormatDesc.PreparePixel(Pixel);
  4475. src := Data;
  4476. dst := aImage.PixelData;
  4477. for y := 0 to Height-1 do
  4478. for x := 0 to Width-1 do begin
  4479. FormatDesc.Unmap(src, Pixel, srcMD);
  4480. case rid.BitsPerPixel of
  4481. 8: begin
  4482. dst^ := Pixel.Data.a;
  4483. inc(dst);
  4484. end;
  4485. 16: begin
  4486. PWord(dst)^ := Pixel.Data.a;
  4487. inc(dst, 2);
  4488. end;
  4489. 24: begin
  4490. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4491. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4492. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4493. inc(dst, 3);
  4494. end;
  4495. 32: begin
  4496. PCardinal(dst)^ := Pixel.Data.a;
  4497. inc(dst, 4);
  4498. end;
  4499. else
  4500. raise EglBitmapUnsupportedFormat.Create(Format);
  4501. end;
  4502. end;
  4503. finally
  4504. FormatDesc.FreeMappingData(srcMD);
  4505. end;
  4506. result := true;
  4507. end;
  4508. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4509. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4510. var
  4511. tex: TglBitmap2D;
  4512. begin
  4513. tex := TglBitmap2D.Create;
  4514. try
  4515. tex.AssignFromLazIntfImage(aImage);
  4516. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4517. finally
  4518. tex.Free;
  4519. end;
  4520. end;
  4521. {$ENDIF}
  4522. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4523. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4524. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4525. var
  4526. rs: TResourceStream;
  4527. begin
  4528. PrepareResType(aResource, aResType);
  4529. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4530. try
  4531. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4532. finally
  4533. rs.Free;
  4534. end;
  4535. end;
  4536. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4537. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4538. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4539. var
  4540. rs: TResourceStream;
  4541. begin
  4542. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4543. try
  4544. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4545. finally
  4546. rs.Free;
  4547. end;
  4548. end;
  4549. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4550. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4551. begin
  4552. if TFormatDescriptor.Get(Format).IsCompressed then
  4553. raise EglBitmapUnsupportedFormat.Create(Format);
  4554. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4555. end;
  4556. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4557. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4558. var
  4559. FS: TFileStream;
  4560. begin
  4561. FS := TFileStream.Create(aFileName, fmOpenRead);
  4562. try
  4563. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4564. finally
  4565. FS.Free;
  4566. end;
  4567. end;
  4568. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4569. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4570. var
  4571. tex: TglBitmap2D;
  4572. begin
  4573. tex := TglBitmap2D.Create(aStream);
  4574. try
  4575. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4576. finally
  4577. tex.Free;
  4578. end;
  4579. end;
  4580. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4581. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4582. var
  4583. DestData, DestData2, SourceData: pByte;
  4584. TempHeight, TempWidth: Integer;
  4585. SourceFD, DestFD: TFormatDescriptor;
  4586. SourceMD, DestMD, DestMD2: Pointer;
  4587. FuncRec: TglBitmapFunctionRec;
  4588. begin
  4589. result := false;
  4590. Assert(Assigned(Data));
  4591. Assert(Assigned(aBitmap));
  4592. Assert(Assigned(aBitmap.Data));
  4593. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4594. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4595. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4596. DestFD := TFormatDescriptor.Get(Format);
  4597. if not Assigned(aFunc) then begin
  4598. aFunc := glBitmapAlphaFunc;
  4599. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4600. end else
  4601. FuncRec.Args := aArgs;
  4602. // Values
  4603. TempHeight := aBitmap.FileHeight;
  4604. TempWidth := aBitmap.FileWidth;
  4605. FuncRec.Sender := Self;
  4606. FuncRec.Size := Dimension;
  4607. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4608. DestData := Data;
  4609. DestData2 := Data;
  4610. SourceData := aBitmap.Data;
  4611. // Mapping
  4612. SourceFD.PreparePixel(FuncRec.Source);
  4613. DestFD.PreparePixel (FuncRec.Dest);
  4614. SourceMD := SourceFD.CreateMappingData;
  4615. DestMD := DestFD.CreateMappingData;
  4616. DestMD2 := DestFD.CreateMappingData;
  4617. try
  4618. FuncRec.Position.Y := 0;
  4619. while FuncRec.Position.Y < TempHeight do begin
  4620. FuncRec.Position.X := 0;
  4621. while FuncRec.Position.X < TempWidth do begin
  4622. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4623. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4624. aFunc(FuncRec);
  4625. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4626. inc(FuncRec.Position.X);
  4627. end;
  4628. inc(FuncRec.Position.Y);
  4629. end;
  4630. finally
  4631. SourceFD.FreeMappingData(SourceMD);
  4632. DestFD.FreeMappingData(DestMD);
  4633. DestFD.FreeMappingData(DestMD2);
  4634. end;
  4635. end;
  4636. end;
  4637. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4638. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4639. begin
  4640. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4641. end;
  4642. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4643. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4644. var
  4645. PixelData: TglBitmapPixelData;
  4646. begin
  4647. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4648. result := AddAlphaFromColorKeyFloat(
  4649. aRed / PixelData.Range.r,
  4650. aGreen / PixelData.Range.g,
  4651. aBlue / PixelData.Range.b,
  4652. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4653. end;
  4654. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4655. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4656. var
  4657. values: array[0..2] of Single;
  4658. tmp: Cardinal;
  4659. i: Integer;
  4660. PixelData: TglBitmapPixelData;
  4661. begin
  4662. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4663. with PixelData do begin
  4664. values[0] := aRed;
  4665. values[1] := aGreen;
  4666. values[2] := aBlue;
  4667. for i := 0 to 2 do begin
  4668. tmp := Trunc(Range.arr[i] * aDeviation);
  4669. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4670. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4671. end;
  4672. Data.a := 0;
  4673. Range.a := 0;
  4674. end;
  4675. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4676. end;
  4677. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4678. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4679. begin
  4680. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4681. end;
  4682. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4683. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4684. var
  4685. PixelData: TglBitmapPixelData;
  4686. begin
  4687. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4688. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4689. end;
  4690. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4691. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4692. var
  4693. PixelData: TglBitmapPixelData;
  4694. begin
  4695. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4696. with PixelData do
  4697. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4698. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4699. end;
  4700. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4701. function TglBitmap.RemoveAlpha: Boolean;
  4702. var
  4703. FormatDesc: TFormatDescriptor;
  4704. begin
  4705. result := false;
  4706. FormatDesc := TFormatDescriptor.Get(Format);
  4707. if Assigned(Data) then begin
  4708. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4709. raise EglBitmapUnsupportedFormat.Create(Format);
  4710. result := ConvertTo(FormatDesc.WithoutAlpha);
  4711. end;
  4712. end;
  4713. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4714. function TglBitmap.Clone: TglBitmap;
  4715. var
  4716. Temp: TglBitmap;
  4717. TempPtr: PByte;
  4718. Size: Integer;
  4719. begin
  4720. result := nil;
  4721. Temp := (ClassType.Create as TglBitmap);
  4722. try
  4723. // copy texture data if assigned
  4724. if Assigned(Data) then begin
  4725. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4726. GetMem(TempPtr, Size);
  4727. try
  4728. Move(Data^, TempPtr^, Size);
  4729. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4730. except
  4731. if Assigned(TempPtr) then
  4732. FreeMem(TempPtr);
  4733. raise;
  4734. end;
  4735. end else begin
  4736. TempPtr := nil;
  4737. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4738. end;
  4739. // copy properties
  4740. Temp.fID := ID;
  4741. Temp.fTarget := Target;
  4742. Temp.fFormat := Format;
  4743. Temp.fMipMap := MipMap;
  4744. Temp.fAnisotropic := Anisotropic;
  4745. Temp.fBorderColor := fBorderColor;
  4746. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4747. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4748. Temp.fFilterMin := fFilterMin;
  4749. Temp.fFilterMag := fFilterMag;
  4750. Temp.fWrapS := fWrapS;
  4751. Temp.fWrapT := fWrapT;
  4752. Temp.fWrapR := fWrapR;
  4753. Temp.fFilename := fFilename;
  4754. Temp.fCustomName := fCustomName;
  4755. Temp.fCustomNameW := fCustomNameW;
  4756. Temp.fCustomData := fCustomData;
  4757. result := Temp;
  4758. except
  4759. FreeAndNil(Temp);
  4760. raise;
  4761. end;
  4762. end;
  4763. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4764. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4765. var
  4766. SourceFD, DestFD: TFormatDescriptor;
  4767. SourcePD, DestPD: TglBitmapPixelData;
  4768. ShiftData: TShiftData;
  4769. function CanCopyDirect: Boolean;
  4770. begin
  4771. result :=
  4772. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4773. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4774. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4775. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4776. end;
  4777. function CanShift: Boolean;
  4778. begin
  4779. result :=
  4780. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4781. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4782. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4783. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4784. end;
  4785. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4786. begin
  4787. result := 0;
  4788. while (aSource > aDest) and (aSource > 0) do begin
  4789. inc(result);
  4790. aSource := aSource shr 1;
  4791. end;
  4792. end;
  4793. begin
  4794. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4795. SourceFD := TFormatDescriptor.Get(Format);
  4796. DestFD := TFormatDescriptor.Get(aFormat);
  4797. SourceFD.PreparePixel(SourcePD);
  4798. DestFD.PreparePixel (DestPD);
  4799. if CanCopyDirect then
  4800. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4801. else if CanShift then begin
  4802. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4803. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4804. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4805. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4806. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4807. end else
  4808. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4809. end else
  4810. result := true;
  4811. end;
  4812. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4813. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4814. begin
  4815. if aUseRGB or aUseAlpha then
  4816. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4817. ((Byte(aUseAlpha) and 1) shl 1) or
  4818. (Byte(aUseRGB) and 1) ));
  4819. end;
  4820. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4821. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4822. begin
  4823. fBorderColor[0] := aRed;
  4824. fBorderColor[1] := aGreen;
  4825. fBorderColor[2] := aBlue;
  4826. fBorderColor[3] := aAlpha;
  4827. if (ID > 0) then begin
  4828. Bind(false);
  4829. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4830. end;
  4831. end;
  4832. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4833. procedure TglBitmap.FreeData;
  4834. var
  4835. TempPtr: PByte;
  4836. begin
  4837. TempPtr := nil;
  4838. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  4839. end;
  4840. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4841. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4842. const aAlpha: Byte);
  4843. begin
  4844. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4845. end;
  4846. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4847. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4848. var
  4849. PixelData: TglBitmapPixelData;
  4850. begin
  4851. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4852. FillWithColorFloat(
  4853. aRed / PixelData.Range.r,
  4854. aGreen / PixelData.Range.g,
  4855. aBlue / PixelData.Range.b,
  4856. aAlpha / PixelData.Range.a);
  4857. end;
  4858. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4859. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4860. var
  4861. PixelData: TglBitmapPixelData;
  4862. begin
  4863. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4864. with PixelData do begin
  4865. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4866. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4867. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4868. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4869. end;
  4870. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4871. end;
  4872. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4873. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  4874. begin
  4875. //check MIN filter
  4876. case aMin of
  4877. GL_NEAREST:
  4878. fFilterMin := GL_NEAREST;
  4879. GL_LINEAR:
  4880. fFilterMin := GL_LINEAR;
  4881. GL_NEAREST_MIPMAP_NEAREST:
  4882. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4883. GL_LINEAR_MIPMAP_NEAREST:
  4884. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4885. GL_NEAREST_MIPMAP_LINEAR:
  4886. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4887. GL_LINEAR_MIPMAP_LINEAR:
  4888. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4889. else
  4890. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  4891. end;
  4892. //check MAG filter
  4893. case aMag of
  4894. GL_NEAREST:
  4895. fFilterMag := GL_NEAREST;
  4896. GL_LINEAR:
  4897. fFilterMag := GL_LINEAR;
  4898. else
  4899. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  4900. end;
  4901. //apply filter
  4902. if (ID > 0) then begin
  4903. Bind(false);
  4904. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4905. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4906. case fFilterMin of
  4907. GL_NEAREST, GL_LINEAR:
  4908. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4909. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4910. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4911. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4912. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4913. end;
  4914. end else
  4915. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4916. end;
  4917. end;
  4918. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4919. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  4920. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4921. begin
  4922. case aValue of
  4923. GL_CLAMP:
  4924. aTarget := GL_CLAMP;
  4925. GL_REPEAT:
  4926. aTarget := GL_REPEAT;
  4927. GL_CLAMP_TO_EDGE: begin
  4928. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4929. aTarget := GL_CLAMP_TO_EDGE
  4930. else
  4931. aTarget := GL_CLAMP;
  4932. end;
  4933. GL_CLAMP_TO_BORDER: begin
  4934. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4935. aTarget := GL_CLAMP_TO_BORDER
  4936. else
  4937. aTarget := GL_CLAMP;
  4938. end;
  4939. GL_MIRRORED_REPEAT: begin
  4940. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4941. aTarget := GL_MIRRORED_REPEAT
  4942. else
  4943. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4944. end;
  4945. else
  4946. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  4947. end;
  4948. end;
  4949. begin
  4950. CheckAndSetWrap(S, fWrapS);
  4951. CheckAndSetWrap(T, fWrapT);
  4952. CheckAndSetWrap(R, fWrapR);
  4953. if (ID > 0) then begin
  4954. Bind(false);
  4955. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4956. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4957. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4958. end;
  4959. end;
  4960. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4961. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  4962. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  4963. begin
  4964. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  4965. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  4966. fSwizzle[aIndex] := aValue
  4967. else
  4968. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  4969. end;
  4970. begin
  4971. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4972. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  4973. CheckAndSetValue(r, 0);
  4974. CheckAndSetValue(g, 1);
  4975. CheckAndSetValue(b, 2);
  4976. CheckAndSetValue(a, 3);
  4977. if (ID > 0) then begin
  4978. Bind(false);
  4979. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  4980. end;
  4981. end;
  4982. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4983. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4984. begin
  4985. if aEnableTextureUnit then
  4986. glEnable(Target);
  4987. if (ID > 0) then
  4988. glBindTexture(Target, ID);
  4989. end;
  4990. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4991. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4992. begin
  4993. if aDisableTextureUnit then
  4994. glDisable(Target);
  4995. glBindTexture(Target, 0);
  4996. end;
  4997. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4998. constructor TglBitmap.Create;
  4999. begin
  5000. if (ClassType = TglBitmap) then
  5001. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  5002. {$IFDEF GLB_NATIVE_OGL}
  5003. glbReadOpenGLExtensions;
  5004. {$ENDIF}
  5005. inherited Create;
  5006. fFormat := glBitmapGetDefaultFormat;
  5007. fFreeDataOnDestroy := true;
  5008. end;
  5009. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5010. constructor TglBitmap.Create(const aFileName: String);
  5011. begin
  5012. Create;
  5013. LoadFromFile(aFileName);
  5014. end;
  5015. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5016. constructor TglBitmap.Create(const aStream: TStream);
  5017. begin
  5018. Create;
  5019. LoadFromStream(aStream);
  5020. end;
  5021. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5022. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
  5023. var
  5024. ImageSize: Integer;
  5025. begin
  5026. Create;
  5027. if not Assigned(aData) then begin
  5028. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5029. GetMem(aData, ImageSize);
  5030. try
  5031. FillChar(aData^, ImageSize, #$FF);
  5032. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5033. except
  5034. if Assigned(aData) then
  5035. FreeMem(aData);
  5036. raise;
  5037. end;
  5038. end else begin
  5039. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5040. fFreeDataOnDestroy := false;
  5041. end;
  5042. end;
  5043. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5044. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5045. begin
  5046. Create;
  5047. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  5048. end;
  5049. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5050. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  5051. begin
  5052. Create;
  5053. LoadFromResource(aInstance, aResource, aResType);
  5054. end;
  5055. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5056. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5057. begin
  5058. Create;
  5059. LoadFromResourceID(aInstance, aResourceID, aResType);
  5060. end;
  5061. {$IFDEF GLB_SUPPORT_PNG_READ}
  5062. {$IF DEFINED(GLB_LAZ_PNG)}
  5063. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5064. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5065. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5066. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5067. const
  5068. MAGIC_LEN = 8;
  5069. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  5070. var
  5071. reader: TLazReaderPNG;
  5072. intf: TLazIntfImage;
  5073. StreamPos: Int64;
  5074. magic: String[MAGIC_LEN];
  5075. begin
  5076. result := true;
  5077. StreamPos := aStream.Position;
  5078. SetLength(magic, MAGIC_LEN);
  5079. aStream.Read(magic[1], MAGIC_LEN);
  5080. aStream.Position := StreamPos;
  5081. if (magic <> PNG_MAGIC) then begin
  5082. result := false;
  5083. exit;
  5084. end;
  5085. intf := TLazIntfImage.Create(0, 0);
  5086. reader := TLazReaderPNG.Create;
  5087. try try
  5088. reader.UpdateDescription := true;
  5089. reader.ImageRead(aStream, intf);
  5090. AssignFromLazIntfImage(intf);
  5091. except
  5092. result := false;
  5093. aStream.Position := StreamPos;
  5094. exit;
  5095. end;
  5096. finally
  5097. reader.Free;
  5098. intf.Free;
  5099. end;
  5100. end;
  5101. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5102. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5103. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5104. var
  5105. Surface: PSDL_Surface;
  5106. RWops: PSDL_RWops;
  5107. begin
  5108. result := false;
  5109. RWops := glBitmapCreateRWops(aStream);
  5110. try
  5111. if IMG_isPNG(RWops) > 0 then begin
  5112. Surface := IMG_LoadPNG_RW(RWops);
  5113. try
  5114. AssignFromSurface(Surface);
  5115. result := true;
  5116. finally
  5117. SDL_FreeSurface(Surface);
  5118. end;
  5119. end;
  5120. finally
  5121. SDL_FreeRW(RWops);
  5122. end;
  5123. end;
  5124. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5125. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5126. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5127. begin
  5128. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5129. end;
  5130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5131. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5132. var
  5133. StreamPos: Int64;
  5134. signature: array [0..7] of byte;
  5135. png: png_structp;
  5136. png_info: png_infop;
  5137. TempHeight, TempWidth: Integer;
  5138. Format: TglBitmapFormat;
  5139. png_data: pByte;
  5140. png_rows: array of pByte;
  5141. Row, LineSize: Integer;
  5142. begin
  5143. result := false;
  5144. if not init_libPNG then
  5145. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5146. try
  5147. // signature
  5148. StreamPos := aStream.Position;
  5149. aStream.Read(signature{%H-}, 8);
  5150. aStream.Position := StreamPos;
  5151. if png_check_sig(@signature, 8) <> 0 then begin
  5152. // png read struct
  5153. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5154. if png = nil then
  5155. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5156. // png info
  5157. png_info := png_create_info_struct(png);
  5158. if png_info = nil then begin
  5159. png_destroy_read_struct(@png, nil, nil);
  5160. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5161. end;
  5162. // set read callback
  5163. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5164. // read informations
  5165. png_read_info(png, png_info);
  5166. // size
  5167. TempHeight := png_get_image_height(png, png_info);
  5168. TempWidth := png_get_image_width(png, png_info);
  5169. // format
  5170. case png_get_color_type(png, png_info) of
  5171. PNG_COLOR_TYPE_GRAY:
  5172. Format := tfLuminance8;
  5173. PNG_COLOR_TYPE_GRAY_ALPHA:
  5174. Format := tfLuminance8Alpha8;
  5175. PNG_COLOR_TYPE_RGB:
  5176. Format := tfRGB8;
  5177. PNG_COLOR_TYPE_RGB_ALPHA:
  5178. Format := tfRGBA8;
  5179. else
  5180. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5181. end;
  5182. // cut upper 8 bit from 16 bit formats
  5183. if png_get_bit_depth(png, png_info) > 8 then
  5184. png_set_strip_16(png);
  5185. // expand bitdepth smaller than 8
  5186. if png_get_bit_depth(png, png_info) < 8 then
  5187. png_set_expand(png);
  5188. // allocating mem for scanlines
  5189. LineSize := png_get_rowbytes(png, png_info);
  5190. GetMem(png_data, TempHeight * LineSize);
  5191. try
  5192. SetLength(png_rows, TempHeight);
  5193. for Row := Low(png_rows) to High(png_rows) do begin
  5194. png_rows[Row] := png_data;
  5195. Inc(png_rows[Row], Row * LineSize);
  5196. end;
  5197. // read complete image into scanlines
  5198. png_read_image(png, @png_rows[0]);
  5199. // read end
  5200. png_read_end(png, png_info);
  5201. // destroy read struct
  5202. png_destroy_read_struct(@png, @png_info, nil);
  5203. SetLength(png_rows, 0);
  5204. // set new data
  5205. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5206. result := true;
  5207. except
  5208. if Assigned(png_data) then
  5209. FreeMem(png_data);
  5210. raise;
  5211. end;
  5212. end;
  5213. finally
  5214. quit_libPNG;
  5215. end;
  5216. end;
  5217. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5218. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5219. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5220. var
  5221. StreamPos: Int64;
  5222. Png: TPNGObject;
  5223. Header: String[8];
  5224. Row, Col, PixSize, LineSize: Integer;
  5225. NewImage, pSource, pDest, pAlpha: pByte;
  5226. PngFormat: TglBitmapFormat;
  5227. FormatDesc: TFormatDescriptor;
  5228. const
  5229. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5230. begin
  5231. result := false;
  5232. StreamPos := aStream.Position;
  5233. aStream.Read(Header[0], SizeOf(Header));
  5234. aStream.Position := StreamPos;
  5235. {Test if the header matches}
  5236. if Header = PngHeader then begin
  5237. Png := TPNGObject.Create;
  5238. try
  5239. Png.LoadFromStream(aStream);
  5240. case Png.Header.ColorType of
  5241. COLOR_GRAYSCALE:
  5242. PngFormat := tfLuminance8;
  5243. COLOR_GRAYSCALEALPHA:
  5244. PngFormat := tfLuminance8Alpha8;
  5245. COLOR_RGB:
  5246. PngFormat := tfBGR8;
  5247. COLOR_RGBALPHA:
  5248. PngFormat := tfBGRA8;
  5249. else
  5250. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5251. end;
  5252. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5253. PixSize := Round(FormatDesc.PixelSize);
  5254. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5255. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5256. try
  5257. pDest := NewImage;
  5258. case Png.Header.ColorType of
  5259. COLOR_RGB, COLOR_GRAYSCALE:
  5260. begin
  5261. for Row := 0 to Png.Height -1 do begin
  5262. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5263. Inc(pDest, LineSize);
  5264. end;
  5265. end;
  5266. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5267. begin
  5268. PixSize := PixSize -1;
  5269. for Row := 0 to Png.Height -1 do begin
  5270. pSource := Png.Scanline[Row];
  5271. pAlpha := pByte(Png.AlphaScanline[Row]);
  5272. for Col := 0 to Png.Width -1 do begin
  5273. Move (pSource^, pDest^, PixSize);
  5274. Inc(pSource, PixSize);
  5275. Inc(pDest, PixSize);
  5276. pDest^ := pAlpha^;
  5277. inc(pAlpha);
  5278. Inc(pDest);
  5279. end;
  5280. end;
  5281. end;
  5282. else
  5283. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5284. end;
  5285. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5286. result := true;
  5287. except
  5288. if Assigned(NewImage) then
  5289. FreeMem(NewImage);
  5290. raise;
  5291. end;
  5292. finally
  5293. Png.Free;
  5294. end;
  5295. end;
  5296. end;
  5297. {$IFEND}
  5298. {$ENDIF}
  5299. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5300. {$IFDEF GLB_LIB_PNG}
  5301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5302. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5303. begin
  5304. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5305. end;
  5306. {$ENDIF}
  5307. {$IF DEFINED(GLB_LAZ_PNG)}
  5308. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5309. procedure TglBitmap.SavePNG(const aStream: TStream);
  5310. var
  5311. png: TPortableNetworkGraphic;
  5312. intf: TLazIntfImage;
  5313. raw: TRawImage;
  5314. begin
  5315. png := TPortableNetworkGraphic.Create;
  5316. intf := TLazIntfImage.Create(0, 0);
  5317. try
  5318. if not AssignToLazIntfImage(intf) then
  5319. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5320. intf.GetRawImage(raw);
  5321. png.LoadFromRawImage(raw, false);
  5322. png.SaveToStream(aStream);
  5323. finally
  5324. png.Free;
  5325. intf.Free;
  5326. end;
  5327. end;
  5328. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5329. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5330. procedure TglBitmap.SavePNG(const aStream: TStream);
  5331. var
  5332. png: png_structp;
  5333. png_info: png_infop;
  5334. png_rows: array of pByte;
  5335. LineSize: Integer;
  5336. ColorType: Integer;
  5337. Row: Integer;
  5338. FormatDesc: TFormatDescriptor;
  5339. begin
  5340. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5341. raise EglBitmapUnsupportedFormat.Create(Format);
  5342. if not init_libPNG then
  5343. raise Exception.Create('unable to initialize libPNG.');
  5344. try
  5345. case Format of
  5346. tfAlpha8, tfLuminance8:
  5347. ColorType := PNG_COLOR_TYPE_GRAY;
  5348. tfLuminance8Alpha8:
  5349. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5350. tfBGR8, tfRGB8:
  5351. ColorType := PNG_COLOR_TYPE_RGB;
  5352. tfBGRA8, tfRGBA8:
  5353. ColorType := PNG_COLOR_TYPE_RGBA;
  5354. else
  5355. raise EglBitmapUnsupportedFormat.Create(Format);
  5356. end;
  5357. FormatDesc := TFormatDescriptor.Get(Format);
  5358. LineSize := FormatDesc.GetSize(Width, 1);
  5359. // creating array for scanline
  5360. SetLength(png_rows, Height);
  5361. try
  5362. for Row := 0 to Height - 1 do begin
  5363. png_rows[Row] := Data;
  5364. Inc(png_rows[Row], Row * LineSize)
  5365. end;
  5366. // write struct
  5367. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5368. if png = nil then
  5369. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5370. // create png info
  5371. png_info := png_create_info_struct(png);
  5372. if png_info = nil then begin
  5373. png_destroy_write_struct(@png, nil);
  5374. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5375. end;
  5376. // set read callback
  5377. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5378. // set compression
  5379. png_set_compression_level(png, 6);
  5380. if Format in [tfBGR8, tfBGRA8] then
  5381. png_set_bgr(png);
  5382. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5383. png_write_info(png, png_info);
  5384. png_write_image(png, @png_rows[0]);
  5385. png_write_end(png, png_info);
  5386. png_destroy_write_struct(@png, @png_info);
  5387. finally
  5388. SetLength(png_rows, 0);
  5389. end;
  5390. finally
  5391. quit_libPNG;
  5392. end;
  5393. end;
  5394. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5395. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5396. procedure TglBitmap.SavePNG(const aStream: TStream);
  5397. var
  5398. Png: TPNGObject;
  5399. pSource, pDest: pByte;
  5400. X, Y, PixSize: Integer;
  5401. ColorType: Cardinal;
  5402. Alpha: Boolean;
  5403. pTemp: pByte;
  5404. Temp: Byte;
  5405. begin
  5406. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5407. raise EglBitmapUnsupportedFormat.Create(Format);
  5408. case Format of
  5409. tfAlpha8, tfLuminance8: begin
  5410. ColorType := COLOR_GRAYSCALE;
  5411. PixSize := 1;
  5412. Alpha := false;
  5413. end;
  5414. tfLuminance8Alpha8: begin
  5415. ColorType := COLOR_GRAYSCALEALPHA;
  5416. PixSize := 1;
  5417. Alpha := true;
  5418. end;
  5419. tfBGR8, tfRGB8: begin
  5420. ColorType := COLOR_RGB;
  5421. PixSize := 3;
  5422. Alpha := false;
  5423. end;
  5424. tfBGRA8, tfRGBA8: begin
  5425. ColorType := COLOR_RGBALPHA;
  5426. PixSize := 3;
  5427. Alpha := true
  5428. end;
  5429. else
  5430. raise EglBitmapUnsupportedFormat.Create(Format);
  5431. end;
  5432. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5433. try
  5434. // Copy ImageData
  5435. pSource := Data;
  5436. for Y := 0 to Height -1 do begin
  5437. pDest := png.ScanLine[Y];
  5438. for X := 0 to Width -1 do begin
  5439. Move(pSource^, pDest^, PixSize);
  5440. Inc(pDest, PixSize);
  5441. Inc(pSource, PixSize);
  5442. if Alpha then begin
  5443. png.AlphaScanline[Y]^[X] := pSource^;
  5444. Inc(pSource);
  5445. end;
  5446. end;
  5447. // convert RGB line to BGR
  5448. if Format in [tfRGB8, tfRGBA8] then begin
  5449. pTemp := png.ScanLine[Y];
  5450. for X := 0 to Width -1 do begin
  5451. Temp := pByteArray(pTemp)^[0];
  5452. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5453. pByteArray(pTemp)^[2] := Temp;
  5454. Inc(pTemp, 3);
  5455. end;
  5456. end;
  5457. end;
  5458. // Save to Stream
  5459. Png.CompressionLevel := 6;
  5460. Png.SaveToStream(aStream);
  5461. finally
  5462. FreeAndNil(Png);
  5463. end;
  5464. end;
  5465. {$IFEND}
  5466. {$ENDIF}
  5467. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5468. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5469. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5470. {$IFDEF GLB_LIB_JPEG}
  5471. type
  5472. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5473. glBitmap_libJPEG_source_mgr = record
  5474. pub: jpeg_source_mgr;
  5475. SrcStream: TStream;
  5476. SrcBuffer: array [1..4096] of byte;
  5477. end;
  5478. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5479. glBitmap_libJPEG_dest_mgr = record
  5480. pub: jpeg_destination_mgr;
  5481. DestStream: TStream;
  5482. DestBuffer: array [1..4096] of byte;
  5483. end;
  5484. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5485. begin
  5486. //DUMMY
  5487. end;
  5488. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5489. begin
  5490. //DUMMY
  5491. end;
  5492. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5493. begin
  5494. //DUMMY
  5495. end;
  5496. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5497. begin
  5498. //DUMMY
  5499. end;
  5500. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5501. begin
  5502. //DUMMY
  5503. end;
  5504. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5505. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5506. var
  5507. src: glBitmap_libJPEG_source_mgr_ptr;
  5508. bytes: integer;
  5509. begin
  5510. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5511. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5512. if (bytes <= 0) then begin
  5513. src^.SrcBuffer[1] := $FF;
  5514. src^.SrcBuffer[2] := JPEG_EOI;
  5515. bytes := 2;
  5516. end;
  5517. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5518. src^.pub.bytes_in_buffer := bytes;
  5519. result := true;
  5520. end;
  5521. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5522. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5523. var
  5524. src: glBitmap_libJPEG_source_mgr_ptr;
  5525. begin
  5526. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5527. if num_bytes > 0 then begin
  5528. // wanted byte isn't in buffer so set stream position and read buffer
  5529. if num_bytes > src^.pub.bytes_in_buffer then begin
  5530. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5531. src^.pub.fill_input_buffer(cinfo);
  5532. end else begin
  5533. // wanted byte is in buffer so only skip
  5534. inc(src^.pub.next_input_byte, num_bytes);
  5535. dec(src^.pub.bytes_in_buffer, num_bytes);
  5536. end;
  5537. end;
  5538. end;
  5539. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5540. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5541. var
  5542. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5543. begin
  5544. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5545. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5546. // write complete buffer
  5547. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5548. // reset buffer
  5549. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5550. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5551. end;
  5552. result := true;
  5553. end;
  5554. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5555. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5556. var
  5557. Idx: Integer;
  5558. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5559. begin
  5560. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5561. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5562. // check for endblock
  5563. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5564. // write endblock
  5565. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5566. // leave
  5567. break;
  5568. end else
  5569. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5570. end;
  5571. end;
  5572. {$ENDIF}
  5573. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5574. {$IF DEFINED(GLB_LAZ_JPEG)}
  5575. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5576. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5577. const
  5578. MAGIC_LEN = 2;
  5579. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  5580. var
  5581. intf: TLazIntfImage;
  5582. reader: TFPReaderJPEG;
  5583. StreamPos: Int64;
  5584. magic: String[MAGIC_LEN];
  5585. begin
  5586. result := true;
  5587. StreamPos := aStream.Position;
  5588. SetLength(magic, MAGIC_LEN);
  5589. aStream.Read(magic[1], MAGIC_LEN);
  5590. aStream.Position := StreamPos;
  5591. if (magic <> JPEG_MAGIC) then begin
  5592. result := false;
  5593. exit;
  5594. end;
  5595. reader := TFPReaderJPEG.Create;
  5596. intf := TLazIntfImage.Create(0, 0);
  5597. try try
  5598. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  5599. reader.ImageRead(aStream, intf);
  5600. AssignFromLazIntfImage(intf);
  5601. except
  5602. result := false;
  5603. aStream.Position := StreamPos;
  5604. exit;
  5605. end;
  5606. finally
  5607. reader.Free;
  5608. intf.Free;
  5609. end;
  5610. end;
  5611. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5612. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5613. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5614. var
  5615. Surface: PSDL_Surface;
  5616. RWops: PSDL_RWops;
  5617. begin
  5618. result := false;
  5619. RWops := glBitmapCreateRWops(aStream);
  5620. try
  5621. if IMG_isJPG(RWops) > 0 then begin
  5622. Surface := IMG_LoadJPG_RW(RWops);
  5623. try
  5624. AssignFromSurface(Surface);
  5625. result := true;
  5626. finally
  5627. SDL_FreeSurface(Surface);
  5628. end;
  5629. end;
  5630. finally
  5631. SDL_FreeRW(RWops);
  5632. end;
  5633. end;
  5634. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5635. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5636. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5637. var
  5638. StreamPos: Int64;
  5639. Temp: array[0..1]of Byte;
  5640. jpeg: jpeg_decompress_struct;
  5641. jpeg_err: jpeg_error_mgr;
  5642. IntFormat: TglBitmapFormat;
  5643. pImage: pByte;
  5644. TempHeight, TempWidth: Integer;
  5645. pTemp: pByte;
  5646. Row: Integer;
  5647. FormatDesc: TFormatDescriptor;
  5648. begin
  5649. result := false;
  5650. if not init_libJPEG then
  5651. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5652. try
  5653. // reading first two bytes to test file and set cursor back to begin
  5654. StreamPos := aStream.Position;
  5655. aStream.Read({%H-}Temp[0], 2);
  5656. aStream.Position := StreamPos;
  5657. // if Bitmap then read file.
  5658. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5659. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5660. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5661. // error managment
  5662. jpeg.err := jpeg_std_error(@jpeg_err);
  5663. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5664. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5665. // decompression struct
  5666. jpeg_create_decompress(@jpeg);
  5667. // allocation space for streaming methods
  5668. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5669. // seeting up custom functions
  5670. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5671. pub.init_source := glBitmap_libJPEG_init_source;
  5672. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5673. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5674. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5675. pub.term_source := glBitmap_libJPEG_term_source;
  5676. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5677. pub.next_input_byte := nil; // until buffer loaded
  5678. SrcStream := aStream;
  5679. end;
  5680. // set global decoding state
  5681. jpeg.global_state := DSTATE_START;
  5682. // read header of jpeg
  5683. jpeg_read_header(@jpeg, false);
  5684. // setting output parameter
  5685. case jpeg.jpeg_color_space of
  5686. JCS_GRAYSCALE:
  5687. begin
  5688. jpeg.out_color_space := JCS_GRAYSCALE;
  5689. IntFormat := tfLuminance8;
  5690. end;
  5691. else
  5692. jpeg.out_color_space := JCS_RGB;
  5693. IntFormat := tfRGB8;
  5694. end;
  5695. // reading image
  5696. jpeg_start_decompress(@jpeg);
  5697. TempHeight := jpeg.output_height;
  5698. TempWidth := jpeg.output_width;
  5699. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5700. // creating new image
  5701. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5702. try
  5703. pTemp := pImage;
  5704. for Row := 0 to TempHeight -1 do begin
  5705. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5706. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5707. end;
  5708. // finish decompression
  5709. jpeg_finish_decompress(@jpeg);
  5710. // destroy decompression
  5711. jpeg_destroy_decompress(@jpeg);
  5712. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5713. result := true;
  5714. except
  5715. if Assigned(pImage) then
  5716. FreeMem(pImage);
  5717. raise;
  5718. end;
  5719. end;
  5720. finally
  5721. quit_libJPEG;
  5722. end;
  5723. end;
  5724. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5725. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5726. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5727. var
  5728. bmp: TBitmap;
  5729. jpg: TJPEGImage;
  5730. StreamPos: Int64;
  5731. Temp: array[0..1]of Byte;
  5732. begin
  5733. result := false;
  5734. // reading first two bytes to test file and set cursor back to begin
  5735. StreamPos := aStream.Position;
  5736. aStream.Read(Temp[0], 2);
  5737. aStream.Position := StreamPos;
  5738. // if Bitmap then read file.
  5739. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5740. bmp := TBitmap.Create;
  5741. try
  5742. jpg := TJPEGImage.Create;
  5743. try
  5744. jpg.LoadFromStream(aStream);
  5745. bmp.Assign(jpg);
  5746. result := AssignFromBitmap(bmp);
  5747. finally
  5748. jpg.Free;
  5749. end;
  5750. finally
  5751. bmp.Free;
  5752. end;
  5753. end;
  5754. end;
  5755. {$IFEND}
  5756. {$ENDIF}
  5757. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5758. {$IF DEFINED(GLB_LAZ_JPEG)}
  5759. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5760. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5761. var
  5762. jpeg: TJPEGImage;
  5763. intf: TLazIntfImage;
  5764. raw: TRawImage;
  5765. begin
  5766. jpeg := TJPEGImage.Create;
  5767. intf := TLazIntfImage.Create(0, 0);
  5768. try
  5769. if not AssignToLazIntfImage(intf) then
  5770. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5771. intf.GetRawImage(raw);
  5772. jpeg.LoadFromRawImage(raw, false);
  5773. jpeg.SaveToStream(aStream);
  5774. finally
  5775. intf.Free;
  5776. jpeg.Free;
  5777. end;
  5778. end;
  5779. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5780. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5781. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5782. var
  5783. jpeg: jpeg_compress_struct;
  5784. jpeg_err: jpeg_error_mgr;
  5785. Row: Integer;
  5786. pTemp, pTemp2: pByte;
  5787. procedure CopyRow(pDest, pSource: pByte);
  5788. var
  5789. X: Integer;
  5790. begin
  5791. for X := 0 to Width - 1 do begin
  5792. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5793. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5794. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5795. Inc(pDest, 3);
  5796. Inc(pSource, 3);
  5797. end;
  5798. end;
  5799. begin
  5800. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5801. raise EglBitmapUnsupportedFormat.Create(Format);
  5802. if not init_libJPEG then
  5803. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5804. try
  5805. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  5806. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5807. // error managment
  5808. jpeg.err := jpeg_std_error(@jpeg_err);
  5809. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5810. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5811. // compression struct
  5812. jpeg_create_compress(@jpeg);
  5813. // allocation space for streaming methods
  5814. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5815. // seeting up custom functions
  5816. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5817. pub.init_destination := glBitmap_libJPEG_init_destination;
  5818. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5819. pub.term_destination := glBitmap_libJPEG_term_destination;
  5820. pub.next_output_byte := @DestBuffer[1];
  5821. pub.free_in_buffer := Length(DestBuffer);
  5822. DestStream := aStream;
  5823. end;
  5824. // very important state
  5825. jpeg.global_state := CSTATE_START;
  5826. jpeg.image_width := Width;
  5827. jpeg.image_height := Height;
  5828. case Format of
  5829. tfAlpha8, tfLuminance8: begin
  5830. jpeg.input_components := 1;
  5831. jpeg.in_color_space := JCS_GRAYSCALE;
  5832. end;
  5833. tfRGB8, tfBGR8: begin
  5834. jpeg.input_components := 3;
  5835. jpeg.in_color_space := JCS_RGB;
  5836. end;
  5837. end;
  5838. jpeg_set_defaults(@jpeg);
  5839. jpeg_set_quality(@jpeg, 95, true);
  5840. jpeg_start_compress(@jpeg, true);
  5841. pTemp := Data;
  5842. if Format = tfBGR8 then
  5843. GetMem(pTemp2, fRowSize)
  5844. else
  5845. pTemp2 := pTemp;
  5846. try
  5847. for Row := 0 to jpeg.image_height -1 do begin
  5848. // prepare row
  5849. if Format = tfBGR8 then
  5850. CopyRow(pTemp2, pTemp)
  5851. else
  5852. pTemp2 := pTemp;
  5853. // write row
  5854. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5855. inc(pTemp, fRowSize);
  5856. end;
  5857. finally
  5858. // free memory
  5859. if Format = tfBGR8 then
  5860. FreeMem(pTemp2);
  5861. end;
  5862. jpeg_finish_compress(@jpeg);
  5863. jpeg_destroy_compress(@jpeg);
  5864. finally
  5865. quit_libJPEG;
  5866. end;
  5867. end;
  5868. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5869. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5870. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5871. var
  5872. Bmp: TBitmap;
  5873. Jpg: TJPEGImage;
  5874. begin
  5875. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5876. raise EglBitmapUnsupportedFormat.Create(Format);
  5877. Bmp := TBitmap.Create;
  5878. try
  5879. Jpg := TJPEGImage.Create;
  5880. try
  5881. AssignToBitmap(Bmp);
  5882. if (Format in [tfAlpha8, tfLuminance8]) then begin
  5883. Jpg.Grayscale := true;
  5884. Jpg.PixelFormat := jf8Bit;
  5885. end;
  5886. Jpg.Assign(Bmp);
  5887. Jpg.SaveToStream(aStream);
  5888. finally
  5889. FreeAndNil(Jpg);
  5890. end;
  5891. finally
  5892. FreeAndNil(Bmp);
  5893. end;
  5894. end;
  5895. {$IFEND}
  5896. {$ENDIF}
  5897. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5898. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5899. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5900. const
  5901. BMP_MAGIC = $4D42;
  5902. BMP_COMP_RGB = 0;
  5903. BMP_COMP_RLE8 = 1;
  5904. BMP_COMP_RLE4 = 2;
  5905. BMP_COMP_BITFIELDS = 3;
  5906. type
  5907. TBMPHeader = packed record
  5908. bfType: Word;
  5909. bfSize: Cardinal;
  5910. bfReserved1: Word;
  5911. bfReserved2: Word;
  5912. bfOffBits: Cardinal;
  5913. end;
  5914. TBMPInfo = packed record
  5915. biSize: Cardinal;
  5916. biWidth: Longint;
  5917. biHeight: Longint;
  5918. biPlanes: Word;
  5919. biBitCount: Word;
  5920. biCompression: Cardinal;
  5921. biSizeImage: Cardinal;
  5922. biXPelsPerMeter: Longint;
  5923. biYPelsPerMeter: Longint;
  5924. biClrUsed: Cardinal;
  5925. biClrImportant: Cardinal;
  5926. end;
  5927. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5928. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5929. //////////////////////////////////////////////////////////////////////////////////////////////////
  5930. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5931. begin
  5932. result := tfEmpty;
  5933. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5934. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5935. //Read Compression
  5936. case aInfo.biCompression of
  5937. BMP_COMP_RLE4,
  5938. BMP_COMP_RLE8: begin
  5939. raise EglBitmap.Create('RLE compression is not supported');
  5940. end;
  5941. BMP_COMP_BITFIELDS: begin
  5942. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5943. aStream.Read(aMask.r, SizeOf(aMask.r));
  5944. aStream.Read(aMask.g, SizeOf(aMask.g));
  5945. aStream.Read(aMask.b, SizeOf(aMask.b));
  5946. aStream.Read(aMask.a, SizeOf(aMask.a));
  5947. end else
  5948. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  5949. end;
  5950. end;
  5951. //get suitable format
  5952. case aInfo.biBitCount of
  5953. 8: result := tfLuminance8;
  5954. 16: result := tfBGR5;
  5955. 24: result := tfBGR8;
  5956. 32: result := tfBGRA8;
  5957. end;
  5958. end;
  5959. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5960. var
  5961. i, c: Integer;
  5962. ColorTable: TbmpColorTable;
  5963. begin
  5964. result := nil;
  5965. if (aInfo.biBitCount >= 16) then
  5966. exit;
  5967. aFormat := tfLuminance8;
  5968. c := aInfo.biClrUsed;
  5969. if (c = 0) then
  5970. c := 1 shl aInfo.biBitCount;
  5971. SetLength(ColorTable, c);
  5972. for i := 0 to c-1 do begin
  5973. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5974. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5975. aFormat := tfRGB8;
  5976. end;
  5977. result := TbmpColorTableFormat.Create;
  5978. result.PixelSize := aInfo.biBitCount / 8;
  5979. result.ColorTable := ColorTable;
  5980. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5981. end;
  5982. //////////////////////////////////////////////////////////////////////////////////////////////////
  5983. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5984. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5985. var
  5986. TmpFormat: TglBitmapFormat;
  5987. FormatDesc: TFormatDescriptor;
  5988. begin
  5989. result := nil;
  5990. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5991. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5992. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5993. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5994. aFormat := FormatDesc.Format;
  5995. exit;
  5996. end;
  5997. end;
  5998. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5999. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  6000. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  6001. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  6002. result := TbmpBitfieldFormat.Create;
  6003. result.PixelSize := aInfo.biBitCount / 8;
  6004. result.RedMask := aMask.r;
  6005. result.GreenMask := aMask.g;
  6006. result.BlueMask := aMask.b;
  6007. result.AlphaMask := aMask.a;
  6008. end;
  6009. end;
  6010. var
  6011. //simple types
  6012. StartPos: Int64;
  6013. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  6014. PaddingBuff: Cardinal;
  6015. LineBuf, ImageData, TmpData: PByte;
  6016. SourceMD, DestMD: Pointer;
  6017. BmpFormat: TglBitmapFormat;
  6018. //records
  6019. Mask: TglBitmapColorRec;
  6020. Header: TBMPHeader;
  6021. Info: TBMPInfo;
  6022. //classes
  6023. SpecialFormat: TFormatDescriptor;
  6024. FormatDesc: TFormatDescriptor;
  6025. //////////////////////////////////////////////////////////////////////////////////////////////////
  6026. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  6027. var
  6028. i: Integer;
  6029. Pixel: TglBitmapPixelData;
  6030. begin
  6031. aStream.Read(aLineBuf^, rbLineSize);
  6032. SpecialFormat.PreparePixel(Pixel);
  6033. for i := 0 to Info.biWidth-1 do begin
  6034. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  6035. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  6036. FormatDesc.Map(Pixel, aData, DestMD);
  6037. end;
  6038. end;
  6039. begin
  6040. result := false;
  6041. BmpFormat := tfEmpty;
  6042. SpecialFormat := nil;
  6043. LineBuf := nil;
  6044. SourceMD := nil;
  6045. DestMD := nil;
  6046. // Header
  6047. StartPos := aStream.Position;
  6048. aStream.Read(Header{%H-}, SizeOf(Header));
  6049. if Header.bfType = BMP_MAGIC then begin
  6050. try try
  6051. BmpFormat := ReadInfo(Info, Mask);
  6052. SpecialFormat := ReadColorTable(BmpFormat, Info);
  6053. if not Assigned(SpecialFormat) then
  6054. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  6055. aStream.Position := StartPos + Header.bfOffBits;
  6056. if (BmpFormat <> tfEmpty) then begin
  6057. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  6058. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  6059. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  6060. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  6061. //get Memory
  6062. DestMD := FormatDesc.CreateMappingData;
  6063. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  6064. GetMem(ImageData, ImageSize);
  6065. if Assigned(SpecialFormat) then begin
  6066. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  6067. SourceMD := SpecialFormat.CreateMappingData;
  6068. end;
  6069. //read Data
  6070. try try
  6071. FillChar(ImageData^, ImageSize, $FF);
  6072. TmpData := ImageData;
  6073. if (Info.biHeight > 0) then
  6074. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  6075. for i := 0 to Abs(Info.biHeight)-1 do begin
  6076. if Assigned(SpecialFormat) then
  6077. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  6078. else
  6079. aStream.Read(TmpData^, wbLineSize); //else only read data
  6080. if (Info.biHeight > 0) then
  6081. dec(TmpData, wbLineSize)
  6082. else
  6083. inc(TmpData, wbLineSize);
  6084. aStream.Read(PaddingBuff{%H-}, Padding);
  6085. end;
  6086. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6087. result := true;
  6088. finally
  6089. if Assigned(LineBuf) then
  6090. FreeMem(LineBuf);
  6091. if Assigned(SourceMD) then
  6092. SpecialFormat.FreeMappingData(SourceMD);
  6093. FormatDesc.FreeMappingData(DestMD);
  6094. end;
  6095. except
  6096. if Assigned(ImageData) then
  6097. FreeMem(ImageData);
  6098. raise;
  6099. end;
  6100. end else
  6101. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6102. except
  6103. aStream.Position := StartPos;
  6104. raise;
  6105. end;
  6106. finally
  6107. FreeAndNil(SpecialFormat);
  6108. end;
  6109. end
  6110. else aStream.Position := StartPos;
  6111. end;
  6112. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6113. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6114. var
  6115. Header: TBMPHeader;
  6116. Info: TBMPInfo;
  6117. Converter: TFormatDescriptor;
  6118. FormatDesc: TFormatDescriptor;
  6119. SourceFD, DestFD: Pointer;
  6120. pData, srcData, dstData, ConvertBuffer: pByte;
  6121. Pixel: TglBitmapPixelData;
  6122. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6123. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6124. PaddingBuff: Cardinal;
  6125. function GetLineWidth : Integer;
  6126. begin
  6127. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6128. end;
  6129. begin
  6130. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6131. raise EglBitmapUnsupportedFormat.Create(Format);
  6132. Converter := nil;
  6133. FormatDesc := TFormatDescriptor.Get(Format);
  6134. ImageSize := FormatDesc.GetSize(Dimension);
  6135. FillChar(Header{%H-}, SizeOf(Header), 0);
  6136. Header.bfType := BMP_MAGIC;
  6137. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6138. Header.bfReserved1 := 0;
  6139. Header.bfReserved2 := 0;
  6140. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6141. FillChar(Info{%H-}, SizeOf(Info), 0);
  6142. Info.biSize := SizeOf(Info);
  6143. Info.biWidth := Width;
  6144. Info.biHeight := Height;
  6145. Info.biPlanes := 1;
  6146. Info.biCompression := BMP_COMP_RGB;
  6147. Info.biSizeImage := ImageSize;
  6148. try
  6149. case Format of
  6150. tfLuminance4: begin
  6151. Info.biBitCount := 4;
  6152. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  6153. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  6154. Converter := TbmpColorTableFormat.Create;
  6155. with (Converter as TbmpColorTableFormat) do begin
  6156. PixelSize := 0.5;
  6157. Format := Format;
  6158. Range := glBitmapColorRec($F, $F, $F, $0);
  6159. CreateColorTable;
  6160. end;
  6161. end;
  6162. tfR3G3B2, tfLuminance8: begin
  6163. Info.biBitCount := 8;
  6164. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6165. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6166. Converter := TbmpColorTableFormat.Create;
  6167. with (Converter as TbmpColorTableFormat) do begin
  6168. PixelSize := 1;
  6169. Format := Format;
  6170. if (Format = tfR3G3B2) then begin
  6171. Range := glBitmapColorRec($7, $7, $3, $0);
  6172. Shift := glBitmapShiftRec(0, 3, 6, 0);
  6173. end else
  6174. Range := glBitmapColorRec($FF, $FF, $FF, $0);
  6175. CreateColorTable;
  6176. end;
  6177. end;
  6178. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  6179. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  6180. Info.biBitCount := 16;
  6181. Info.biCompression := BMP_COMP_BITFIELDS;
  6182. end;
  6183. tfBGR8, tfRGB8: begin
  6184. Info.biBitCount := 24;
  6185. if (Format = tfRGB8) then
  6186. Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6187. end;
  6188. tfRGB10, tfRGB10A2, tfRGBA8,
  6189. tfBGR10, tfBGR10A2, tfBGRA8: begin
  6190. Info.biBitCount := 32;
  6191. Info.biCompression := BMP_COMP_BITFIELDS;
  6192. end;
  6193. else
  6194. raise EglBitmapUnsupportedFormat.Create(Format);
  6195. end;
  6196. Info.biXPelsPerMeter := 2835;
  6197. Info.biYPelsPerMeter := 2835;
  6198. // prepare bitmasks
  6199. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6200. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6201. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6202. RedMask := FormatDesc.RedMask;
  6203. GreenMask := FormatDesc.GreenMask;
  6204. BlueMask := FormatDesc.BlueMask;
  6205. AlphaMask := FormatDesc.AlphaMask;
  6206. end;
  6207. // headers
  6208. aStream.Write(Header, SizeOf(Header));
  6209. aStream.Write(Info, SizeOf(Info));
  6210. // colortable
  6211. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6212. with (Converter as TbmpColorTableFormat) do
  6213. aStream.Write(ColorTable[0].b,
  6214. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6215. // bitmasks
  6216. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6217. aStream.Write(RedMask, SizeOf(Cardinal));
  6218. aStream.Write(GreenMask, SizeOf(Cardinal));
  6219. aStream.Write(BlueMask, SizeOf(Cardinal));
  6220. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6221. end;
  6222. // image data
  6223. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  6224. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6225. Padding := GetLineWidth - wbLineSize;
  6226. PaddingBuff := 0;
  6227. pData := Data;
  6228. inc(pData, (Height-1) * rbLineSize);
  6229. // prepare row buffer. But only for RGB because RGBA supports color masks
  6230. // so it's possible to change color within the image.
  6231. if Assigned(Converter) then begin
  6232. FormatDesc.PreparePixel(Pixel);
  6233. GetMem(ConvertBuffer, wbLineSize);
  6234. SourceFD := FormatDesc.CreateMappingData;
  6235. DestFD := Converter.CreateMappingData;
  6236. end else
  6237. ConvertBuffer := nil;
  6238. try
  6239. for LineIdx := 0 to Height - 1 do begin
  6240. // preparing row
  6241. if Assigned(Converter) then begin
  6242. srcData := pData;
  6243. dstData := ConvertBuffer;
  6244. for PixelIdx := 0 to Info.biWidth-1 do begin
  6245. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6246. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6247. Converter.Map(Pixel, dstData, DestFD);
  6248. end;
  6249. aStream.Write(ConvertBuffer^, wbLineSize);
  6250. end else begin
  6251. aStream.Write(pData^, rbLineSize);
  6252. end;
  6253. dec(pData, rbLineSize);
  6254. if (Padding > 0) then
  6255. aStream.Write(PaddingBuff, Padding);
  6256. end;
  6257. finally
  6258. // destroy row buffer
  6259. if Assigned(ConvertBuffer) then begin
  6260. FormatDesc.FreeMappingData(SourceFD);
  6261. Converter.FreeMappingData(DestFD);
  6262. FreeMem(ConvertBuffer);
  6263. end;
  6264. end;
  6265. finally
  6266. if Assigned(Converter) then
  6267. Converter.Free;
  6268. end;
  6269. end;
  6270. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6271. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6272. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6273. type
  6274. TTGAHeader = packed record
  6275. ImageID: Byte;
  6276. ColorMapType: Byte;
  6277. ImageType: Byte;
  6278. //ColorMapSpec: Array[0..4] of Byte;
  6279. ColorMapStart: Word;
  6280. ColorMapLength: Word;
  6281. ColorMapEntrySize: Byte;
  6282. OrigX: Word;
  6283. OrigY: Word;
  6284. Width: Word;
  6285. Height: Word;
  6286. Bpp: Byte;
  6287. ImageDesc: Byte;
  6288. end;
  6289. const
  6290. TGA_UNCOMPRESSED_RGB = 2;
  6291. TGA_UNCOMPRESSED_GRAY = 3;
  6292. TGA_COMPRESSED_RGB = 10;
  6293. TGA_COMPRESSED_GRAY = 11;
  6294. TGA_NONE_COLOR_TABLE = 0;
  6295. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6296. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6297. var
  6298. Header: TTGAHeader;
  6299. ImageData: System.PByte;
  6300. StartPosition: Int64;
  6301. PixelSize, LineSize: Integer;
  6302. tgaFormat: TglBitmapFormat;
  6303. FormatDesc: TFormatDescriptor;
  6304. Counter: packed record
  6305. X, Y: packed record
  6306. low, high, dir: Integer;
  6307. end;
  6308. end;
  6309. const
  6310. CACHE_SIZE = $4000;
  6311. ////////////////////////////////////////////////////////////////////////////////////////
  6312. procedure ReadUncompressed;
  6313. var
  6314. i, j: Integer;
  6315. buf, tmp1, tmp2: System.PByte;
  6316. begin
  6317. buf := nil;
  6318. if (Counter.X.dir < 0) then
  6319. GetMem(buf, LineSize);
  6320. try
  6321. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6322. tmp1 := ImageData;
  6323. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6324. if (Counter.X.dir < 0) then begin //flip X
  6325. aStream.Read(buf^, LineSize);
  6326. tmp2 := buf;
  6327. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6328. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6329. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6330. tmp1^ := tmp2^;
  6331. inc(tmp1);
  6332. inc(tmp2);
  6333. end;
  6334. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6335. end;
  6336. end else
  6337. aStream.Read(tmp1^, LineSize);
  6338. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6339. end;
  6340. finally
  6341. if Assigned(buf) then
  6342. FreeMem(buf);
  6343. end;
  6344. end;
  6345. ////////////////////////////////////////////////////////////////////////////////////////
  6346. procedure ReadCompressed;
  6347. /////////////////////////////////////////////////////////////////
  6348. var
  6349. TmpData: System.PByte;
  6350. LinePixelsRead: Integer;
  6351. procedure CheckLine;
  6352. begin
  6353. if (LinePixelsRead >= Header.Width) then begin
  6354. LinePixelsRead := 0;
  6355. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6356. TmpData := ImageData;
  6357. inc(TmpData, Counter.Y.low * LineSize); //set line
  6358. if (Counter.X.dir < 0) then //if x flipped then
  6359. inc(TmpData, LineSize - PixelSize); //set last pixel
  6360. end;
  6361. end;
  6362. /////////////////////////////////////////////////////////////////
  6363. var
  6364. Cache: PByte;
  6365. CacheSize, CachePos: Integer;
  6366. procedure CachedRead(out Buffer; Count: Integer);
  6367. var
  6368. BytesRead: Integer;
  6369. begin
  6370. if (CachePos + Count > CacheSize) then begin
  6371. //if buffer overflow save non read bytes
  6372. BytesRead := 0;
  6373. if (CacheSize - CachePos > 0) then begin
  6374. BytesRead := CacheSize - CachePos;
  6375. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6376. inc(CachePos, BytesRead);
  6377. end;
  6378. //load cache from file
  6379. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6380. aStream.Read(Cache^, CacheSize);
  6381. CachePos := 0;
  6382. //read rest of requested bytes
  6383. if (Count - BytesRead > 0) then begin
  6384. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6385. inc(CachePos, Count - BytesRead);
  6386. end;
  6387. end else begin
  6388. //if no buffer overflow just read the data
  6389. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6390. inc(CachePos, Count);
  6391. end;
  6392. end;
  6393. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6394. begin
  6395. case PixelSize of
  6396. 1: begin
  6397. aBuffer^ := aData^;
  6398. inc(aBuffer, Counter.X.dir);
  6399. end;
  6400. 2: begin
  6401. PWord(aBuffer)^ := PWord(aData)^;
  6402. inc(aBuffer, 2 * Counter.X.dir);
  6403. end;
  6404. 3: begin
  6405. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6406. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6407. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6408. inc(aBuffer, 3 * Counter.X.dir);
  6409. end;
  6410. 4: begin
  6411. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6412. inc(aBuffer, 4 * Counter.X.dir);
  6413. end;
  6414. end;
  6415. end;
  6416. var
  6417. TotalPixelsToRead, TotalPixelsRead: Integer;
  6418. Temp: Byte;
  6419. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6420. PixelRepeat: Boolean;
  6421. PixelsToRead, PixelCount: Integer;
  6422. begin
  6423. CacheSize := 0;
  6424. CachePos := 0;
  6425. TotalPixelsToRead := Header.Width * Header.Height;
  6426. TotalPixelsRead := 0;
  6427. LinePixelsRead := 0;
  6428. GetMem(Cache, CACHE_SIZE);
  6429. try
  6430. TmpData := ImageData;
  6431. inc(TmpData, Counter.Y.low * LineSize); //set line
  6432. if (Counter.X.dir < 0) then //if x flipped then
  6433. inc(TmpData, LineSize - PixelSize); //set last pixel
  6434. repeat
  6435. //read CommandByte
  6436. CachedRead(Temp, 1);
  6437. PixelRepeat := (Temp and $80) > 0;
  6438. PixelsToRead := (Temp and $7F) + 1;
  6439. inc(TotalPixelsRead, PixelsToRead);
  6440. if PixelRepeat then
  6441. CachedRead(buf[0], PixelSize);
  6442. while (PixelsToRead > 0) do begin
  6443. CheckLine;
  6444. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6445. while (PixelCount > 0) do begin
  6446. if not PixelRepeat then
  6447. CachedRead(buf[0], PixelSize);
  6448. PixelToBuffer(@buf[0], TmpData);
  6449. inc(LinePixelsRead);
  6450. dec(PixelsToRead);
  6451. dec(PixelCount);
  6452. end;
  6453. end;
  6454. until (TotalPixelsRead >= TotalPixelsToRead);
  6455. finally
  6456. FreeMem(Cache);
  6457. end;
  6458. end;
  6459. function IsGrayFormat: Boolean;
  6460. begin
  6461. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6462. end;
  6463. begin
  6464. result := false;
  6465. // reading header to test file and set cursor back to begin
  6466. StartPosition := aStream.Position;
  6467. aStream.Read(Header{%H-}, SizeOf(Header));
  6468. // no colormapped files
  6469. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6470. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6471. begin
  6472. try
  6473. if Header.ImageID <> 0 then // skip image ID
  6474. aStream.Position := aStream.Position + Header.ImageID;
  6475. tgaFormat := tfEmpty;
  6476. case Header.Bpp of
  6477. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6478. 0: tgaFormat := tfLuminance8;
  6479. 8: tgaFormat := tfAlpha8;
  6480. end;
  6481. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6482. 0: tgaFormat := tfLuminance16;
  6483. 8: tgaFormat := tfLuminance8Alpha8;
  6484. end else case (Header.ImageDesc and $F) of
  6485. 0: tgaFormat := tfBGR5;
  6486. 1: tgaFormat := tfBGR5A1;
  6487. 4: tgaFormat := tfBGRA4;
  6488. end;
  6489. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6490. 0: tgaFormat := tfBGR8;
  6491. end;
  6492. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6493. 2: tgaFormat := tfBGR10A2;
  6494. 8: tgaFormat := tfBGRA8;
  6495. end;
  6496. end;
  6497. if (tgaFormat = tfEmpty) then
  6498. raise EglBitmap.Create('LoadTga - unsupported format');
  6499. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6500. PixelSize := FormatDesc.GetSize(1, 1);
  6501. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6502. GetMem(ImageData, LineSize * Header.Height);
  6503. try
  6504. //column direction
  6505. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6506. Counter.X.low := Header.Height-1;;
  6507. Counter.X.high := 0;
  6508. Counter.X.dir := -1;
  6509. end else begin
  6510. Counter.X.low := 0;
  6511. Counter.X.high := Header.Height-1;
  6512. Counter.X.dir := 1;
  6513. end;
  6514. // Row direction
  6515. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6516. Counter.Y.low := 0;
  6517. Counter.Y.high := Header.Height-1;
  6518. Counter.Y.dir := 1;
  6519. end else begin
  6520. Counter.Y.low := Header.Height-1;;
  6521. Counter.Y.high := 0;
  6522. Counter.Y.dir := -1;
  6523. end;
  6524. // Read Image
  6525. case Header.ImageType of
  6526. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6527. ReadUncompressed;
  6528. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6529. ReadCompressed;
  6530. end;
  6531. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6532. result := true;
  6533. except
  6534. if Assigned(ImageData) then
  6535. FreeMem(ImageData);
  6536. raise;
  6537. end;
  6538. finally
  6539. aStream.Position := StartPosition;
  6540. end;
  6541. end
  6542. else aStream.Position := StartPosition;
  6543. end;
  6544. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6545. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6546. var
  6547. Header: TTGAHeader;
  6548. LineSize, Size, x, y: Integer;
  6549. Pixel: TglBitmapPixelData;
  6550. LineBuf, SourceData, DestData: PByte;
  6551. SourceMD, DestMD: Pointer;
  6552. FormatDesc: TFormatDescriptor;
  6553. Converter: TFormatDescriptor;
  6554. begin
  6555. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6556. raise EglBitmapUnsupportedFormat.Create(Format);
  6557. //prepare header
  6558. FillChar(Header{%H-}, SizeOf(Header), 0);
  6559. //set ImageType
  6560. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6561. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6562. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6563. else
  6564. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6565. //set BitsPerPixel
  6566. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6567. Header.Bpp := 8
  6568. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6569. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6570. Header.Bpp := 16
  6571. else if (Format in [tfBGR8, tfRGB8]) then
  6572. Header.Bpp := 24
  6573. else
  6574. Header.Bpp := 32;
  6575. //set AlphaBitCount
  6576. case Format of
  6577. tfRGB5A1, tfBGR5A1:
  6578. Header.ImageDesc := 1 and $F;
  6579. tfRGB10A2, tfBGR10A2:
  6580. Header.ImageDesc := 2 and $F;
  6581. tfRGBA4, tfBGRA4:
  6582. Header.ImageDesc := 4 and $F;
  6583. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6584. Header.ImageDesc := 8 and $F;
  6585. end;
  6586. Header.Width := Width;
  6587. Header.Height := Height;
  6588. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6589. aStream.Write(Header, SizeOf(Header));
  6590. // convert RGB(A) to BGR(A)
  6591. Converter := nil;
  6592. FormatDesc := TFormatDescriptor.Get(Format);
  6593. Size := FormatDesc.GetSize(Dimension);
  6594. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6595. if (FormatDesc.RGBInverted = tfEmpty) then
  6596. raise EglBitmap.Create('inverted RGB format is empty');
  6597. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6598. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6599. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6600. raise EglBitmap.Create('invalid inverted RGB format');
  6601. end;
  6602. if Assigned(Converter) then begin
  6603. LineSize := FormatDesc.GetSize(Width, 1);
  6604. GetMem(LineBuf, LineSize);
  6605. SourceMD := FormatDesc.CreateMappingData;
  6606. DestMD := Converter.CreateMappingData;
  6607. try
  6608. SourceData := Data;
  6609. for y := 0 to Height-1 do begin
  6610. DestData := LineBuf;
  6611. for x := 0 to Width-1 do begin
  6612. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6613. Converter.Map(Pixel, DestData, DestMD);
  6614. end;
  6615. aStream.Write(LineBuf^, LineSize);
  6616. end;
  6617. finally
  6618. FreeMem(LineBuf);
  6619. FormatDesc.FreeMappingData(SourceMD);
  6620. FormatDesc.FreeMappingData(DestMD);
  6621. end;
  6622. end else
  6623. aStream.Write(Data^, Size);
  6624. end;
  6625. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6626. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6627. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6628. const
  6629. DDS_MAGIC: Cardinal = $20534444;
  6630. // DDS_header.dwFlags
  6631. DDSD_CAPS = $00000001;
  6632. DDSD_HEIGHT = $00000002;
  6633. DDSD_WIDTH = $00000004;
  6634. DDSD_PIXELFORMAT = $00001000;
  6635. // DDS_header.sPixelFormat.dwFlags
  6636. DDPF_ALPHAPIXELS = $00000001;
  6637. DDPF_ALPHA = $00000002;
  6638. DDPF_FOURCC = $00000004;
  6639. DDPF_RGB = $00000040;
  6640. DDPF_LUMINANCE = $00020000;
  6641. // DDS_header.sCaps.dwCaps1
  6642. DDSCAPS_TEXTURE = $00001000;
  6643. // DDS_header.sCaps.dwCaps2
  6644. DDSCAPS2_CUBEMAP = $00000200;
  6645. D3DFMT_DXT1 = $31545844;
  6646. D3DFMT_DXT3 = $33545844;
  6647. D3DFMT_DXT5 = $35545844;
  6648. type
  6649. TDDSPixelFormat = packed record
  6650. dwSize: Cardinal;
  6651. dwFlags: Cardinal;
  6652. dwFourCC: Cardinal;
  6653. dwRGBBitCount: Cardinal;
  6654. dwRBitMask: Cardinal;
  6655. dwGBitMask: Cardinal;
  6656. dwBBitMask: Cardinal;
  6657. dwABitMask: Cardinal;
  6658. end;
  6659. TDDSCaps = packed record
  6660. dwCaps1: Cardinal;
  6661. dwCaps2: Cardinal;
  6662. dwDDSX: Cardinal;
  6663. dwReserved: Cardinal;
  6664. end;
  6665. TDDSHeader = packed record
  6666. dwSize: Cardinal;
  6667. dwFlags: Cardinal;
  6668. dwHeight: Cardinal;
  6669. dwWidth: Cardinal;
  6670. dwPitchOrLinearSize: Cardinal;
  6671. dwDepth: Cardinal;
  6672. dwMipMapCount: Cardinal;
  6673. dwReserved: array[0..10] of Cardinal;
  6674. PixelFormat: TDDSPixelFormat;
  6675. Caps: TDDSCaps;
  6676. dwReserved2: Cardinal;
  6677. end;
  6678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6679. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6680. var
  6681. Header: TDDSHeader;
  6682. Converter: TbmpBitfieldFormat;
  6683. function GetDDSFormat: TglBitmapFormat;
  6684. var
  6685. fd: TFormatDescriptor;
  6686. i: Integer;
  6687. Range: TglBitmapColorRec;
  6688. match: Boolean;
  6689. begin
  6690. result := tfEmpty;
  6691. with Header.PixelFormat do begin
  6692. // Compresses
  6693. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6694. case Header.PixelFormat.dwFourCC of
  6695. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6696. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6697. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6698. end;
  6699. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6700. //find matching format
  6701. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6702. fd := TFormatDescriptor.Get(result);
  6703. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6704. (8 * fd.PixelSize = dwRGBBitCount) then
  6705. exit;
  6706. end;
  6707. //find format with same Range
  6708. Range.r := dwRBitMask;
  6709. Range.g := dwGBitMask;
  6710. Range.b := dwBBitMask;
  6711. Range.a := dwABitMask;
  6712. for i := 0 to 3 do begin
  6713. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6714. Range.arr[i] := Range.arr[i] shr 1;
  6715. end;
  6716. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6717. fd := TFormatDescriptor.Get(result);
  6718. match := true;
  6719. for i := 0 to 3 do
  6720. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6721. match := false;
  6722. break;
  6723. end;
  6724. if match then
  6725. break;
  6726. end;
  6727. //no format with same range found -> use default
  6728. if (result = tfEmpty) then begin
  6729. if (dwABitMask > 0) then
  6730. result := tfBGRA8
  6731. else
  6732. result := tfBGR8;
  6733. end;
  6734. Converter := TbmpBitfieldFormat.Create;
  6735. Converter.RedMask := dwRBitMask;
  6736. Converter.GreenMask := dwGBitMask;
  6737. Converter.BlueMask := dwBBitMask;
  6738. Converter.AlphaMask := dwABitMask;
  6739. Converter.PixelSize := dwRGBBitCount / 8;
  6740. end;
  6741. end;
  6742. end;
  6743. var
  6744. StreamPos: Int64;
  6745. x, y, LineSize, RowSize, Magic: Cardinal;
  6746. NewImage, TmpData, RowData, SrcData: System.PByte;
  6747. SourceMD, DestMD: Pointer;
  6748. Pixel: TglBitmapPixelData;
  6749. ddsFormat: TglBitmapFormat;
  6750. FormatDesc: TFormatDescriptor;
  6751. begin
  6752. result := false;
  6753. Converter := nil;
  6754. StreamPos := aStream.Position;
  6755. // Magic
  6756. aStream.Read(Magic{%H-}, sizeof(Magic));
  6757. if (Magic <> DDS_MAGIC) then begin
  6758. aStream.Position := StreamPos;
  6759. exit;
  6760. end;
  6761. //Header
  6762. aStream.Read(Header{%H-}, sizeof(Header));
  6763. if (Header.dwSize <> SizeOf(Header)) or
  6764. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6765. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6766. begin
  6767. aStream.Position := StreamPos;
  6768. exit;
  6769. end;
  6770. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6771. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  6772. ddsFormat := GetDDSFormat;
  6773. try
  6774. if (ddsFormat = tfEmpty) then
  6775. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6776. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6777. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6778. GetMem(NewImage, Header.dwHeight * LineSize);
  6779. try
  6780. TmpData := NewImage;
  6781. //Converter needed
  6782. if Assigned(Converter) then begin
  6783. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6784. GetMem(RowData, RowSize);
  6785. SourceMD := Converter.CreateMappingData;
  6786. DestMD := FormatDesc.CreateMappingData;
  6787. try
  6788. for y := 0 to Header.dwHeight-1 do begin
  6789. TmpData := NewImage;
  6790. inc(TmpData, y * LineSize);
  6791. SrcData := RowData;
  6792. aStream.Read(SrcData^, RowSize);
  6793. for x := 0 to Header.dwWidth-1 do begin
  6794. Converter.Unmap(SrcData, Pixel, SourceMD);
  6795. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6796. FormatDesc.Map(Pixel, TmpData, DestMD);
  6797. end;
  6798. end;
  6799. finally
  6800. Converter.FreeMappingData(SourceMD);
  6801. FormatDesc.FreeMappingData(DestMD);
  6802. FreeMem(RowData);
  6803. end;
  6804. end else
  6805. // Compressed
  6806. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6807. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6808. for Y := 0 to Header.dwHeight-1 do begin
  6809. aStream.Read(TmpData^, RowSize);
  6810. Inc(TmpData, LineSize);
  6811. end;
  6812. end else
  6813. // Uncompressed
  6814. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6815. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6816. for Y := 0 to Header.dwHeight-1 do begin
  6817. aStream.Read(TmpData^, RowSize);
  6818. Inc(TmpData, LineSize);
  6819. end;
  6820. end else
  6821. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6822. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  6823. result := true;
  6824. except
  6825. if Assigned(NewImage) then
  6826. FreeMem(NewImage);
  6827. raise;
  6828. end;
  6829. finally
  6830. FreeAndNil(Converter);
  6831. end;
  6832. end;
  6833. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6834. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6835. var
  6836. Header: TDDSHeader;
  6837. FormatDesc: TFormatDescriptor;
  6838. begin
  6839. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6840. raise EglBitmapUnsupportedFormat.Create(Format);
  6841. FormatDesc := TFormatDescriptor.Get(Format);
  6842. // Generell
  6843. FillChar(Header{%H-}, SizeOf(Header), 0);
  6844. Header.dwSize := SizeOf(Header);
  6845. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6846. Header.dwWidth := Max(1, Width);
  6847. Header.dwHeight := Max(1, Height);
  6848. // Caps
  6849. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6850. // Pixelformat
  6851. Header.PixelFormat.dwSize := sizeof(Header);
  6852. if (FormatDesc.IsCompressed) then begin
  6853. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6854. case Format of
  6855. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6856. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6857. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6858. end;
  6859. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6860. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6861. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6862. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6863. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6864. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6865. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6866. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6867. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6868. end else begin
  6869. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6870. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6871. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6872. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6873. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6874. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6875. end;
  6876. if (FormatDesc.HasAlpha) then
  6877. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6878. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6879. aStream.Write(Header, SizeOf(Header));
  6880. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6881. end;
  6882. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6883. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6884. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6885. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6886. const aWidth: Integer; const aHeight: Integer);
  6887. var
  6888. pTemp: pByte;
  6889. Size: Integer;
  6890. begin
  6891. if (aHeight > 1) then begin
  6892. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  6893. GetMem(pTemp, Size);
  6894. try
  6895. Move(aData^, pTemp^, Size);
  6896. FreeMem(aData);
  6897. aData := nil;
  6898. except
  6899. FreeMem(pTemp);
  6900. raise;
  6901. end;
  6902. end else
  6903. pTemp := aData;
  6904. inherited SetDataPointer(pTemp, aFormat, aWidth);
  6905. end;
  6906. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6907. function TglBitmap1D.FlipHorz: Boolean;
  6908. var
  6909. Col: Integer;
  6910. pTempDest, pDest, pSource: PByte;
  6911. begin
  6912. result := inherited FlipHorz;
  6913. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  6914. pSource := Data;
  6915. GetMem(pDest, fRowSize);
  6916. try
  6917. pTempDest := pDest;
  6918. Inc(pTempDest, fRowSize);
  6919. for Col := 0 to Width-1 do begin
  6920. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  6921. Move(pSource^, pTempDest^, fPixelSize);
  6922. Inc(pSource, fPixelSize);
  6923. end;
  6924. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  6925. result := true;
  6926. except
  6927. if Assigned(pDest) then
  6928. FreeMem(pDest);
  6929. raise;
  6930. end;
  6931. end;
  6932. end;
  6933. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6934. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  6935. var
  6936. FormatDesc: TFormatDescriptor;
  6937. begin
  6938. // Upload data
  6939. FormatDesc := TFormatDescriptor.Get(Format);
  6940. if FormatDesc.IsCompressed then begin
  6941. if not Assigned(glCompressedTexImage1D) then
  6942. raise EglBitmap.Create('compressed formats not supported by video adapter');
  6943. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  6944. end else if aBuildWithGlu then
  6945. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6946. else
  6947. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6948. // Free Data
  6949. if (FreeDataAfterGenTexture) then
  6950. FreeData;
  6951. end;
  6952. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6953. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  6954. var
  6955. BuildWithGlu, TexRec: Boolean;
  6956. TexSize: Integer;
  6957. begin
  6958. if Assigned(Data) then begin
  6959. // Check Texture Size
  6960. if (aTestTextureSize) then begin
  6961. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6962. if (Width > TexSize) then
  6963. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6964. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6965. (Target = GL_TEXTURE_RECTANGLE);
  6966. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6967. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6968. end;
  6969. CreateId;
  6970. SetupParameters(BuildWithGlu);
  6971. UploadData(BuildWithGlu);
  6972. glAreTexturesResident(1, @fID, @fIsResident);
  6973. end;
  6974. end;
  6975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6976. procedure TglBitmap1D.AfterConstruction;
  6977. begin
  6978. inherited;
  6979. Target := GL_TEXTURE_1D;
  6980. end;
  6981. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6982. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6983. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6984. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6985. begin
  6986. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6987. result := fLines[aIndex]
  6988. else
  6989. result := nil;
  6990. end;
  6991. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6992. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6993. const aWidth: Integer; const aHeight: Integer);
  6994. var
  6995. Idx, LineWidth: Integer;
  6996. begin
  6997. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6998. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6999. // Assigning Data
  7000. if Assigned(Data) then begin
  7001. SetLength(fLines, GetHeight);
  7002. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  7003. for Idx := 0 to GetHeight-1 do begin
  7004. fLines[Idx] := Data;
  7005. Inc(fLines[Idx], Idx * LineWidth);
  7006. end;
  7007. end
  7008. else SetLength(fLines, 0);
  7009. end else begin
  7010. SetLength(fLines, 0);
  7011. end;
  7012. end;
  7013. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7014. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  7015. var
  7016. FormatDesc: TFormatDescriptor;
  7017. begin
  7018. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7019. FormatDesc := TFormatDescriptor.Get(Format);
  7020. if FormatDesc.IsCompressed then begin
  7021. if not Assigned(glCompressedTexImage2D) then
  7022. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7023. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  7024. end else if aBuildWithGlu then begin
  7025. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  7026. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7027. end else begin
  7028. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  7029. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7030. end;
  7031. // Freigeben
  7032. if (FreeDataAfterGenTexture) then
  7033. FreeData;
  7034. end;
  7035. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7036. procedure TglBitmap2D.AfterConstruction;
  7037. begin
  7038. inherited;
  7039. Target := GL_TEXTURE_2D;
  7040. end;
  7041. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7042. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  7043. var
  7044. Temp: pByte;
  7045. Size, w, h: Integer;
  7046. FormatDesc: TFormatDescriptor;
  7047. begin
  7048. FormatDesc := TFormatDescriptor.Get(aFormat);
  7049. if FormatDesc.IsCompressed then
  7050. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7051. w := aRight - aLeft;
  7052. h := aBottom - aTop;
  7053. Size := FormatDesc.GetSize(w, h);
  7054. GetMem(Temp, Size);
  7055. try
  7056. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7057. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7058. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  7059. FlipVert;
  7060. except
  7061. if Assigned(Temp) then
  7062. FreeMem(Temp);
  7063. raise;
  7064. end;
  7065. end;
  7066. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7067. procedure TglBitmap2D.GetDataFromTexture;
  7068. var
  7069. Temp: PByte;
  7070. TempWidth, TempHeight: Integer;
  7071. TempIntFormat: GLint;
  7072. IntFormat: TglBitmapFormat;
  7073. FormatDesc: TFormatDescriptor;
  7074. begin
  7075. Bind;
  7076. // Request Data
  7077. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7078. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7079. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7080. IntFormat := tfEmpty;
  7081. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7082. IntFormat := FormatDesc.Format;
  7083. // Getting data from OpenGL
  7084. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7085. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7086. try
  7087. if FormatDesc.IsCompressed then begin
  7088. if not Assigned(glGetCompressedTexImage) then
  7089. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7090. glGetCompressedTexImage(Target, 0, Temp)
  7091. end else
  7092. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7093. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7094. except
  7095. if Assigned(Temp) then
  7096. FreeMem(Temp);
  7097. raise;
  7098. end;
  7099. end;
  7100. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7101. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7102. var
  7103. BuildWithGlu, PotTex, TexRec: Boolean;
  7104. TexSize: Integer;
  7105. begin
  7106. if Assigned(Data) then begin
  7107. // Check Texture Size
  7108. if (aTestTextureSize) then begin
  7109. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7110. if ((Height > TexSize) or (Width > TexSize)) then
  7111. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7112. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7113. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7114. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7115. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7116. end;
  7117. CreateId;
  7118. SetupParameters(BuildWithGlu);
  7119. UploadData(Target, BuildWithGlu);
  7120. glAreTexturesResident(1, @fID, @fIsResident);
  7121. end;
  7122. end;
  7123. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7124. function TglBitmap2D.FlipHorz: Boolean;
  7125. var
  7126. Col, Row: Integer;
  7127. TempDestData, DestData, SourceData: PByte;
  7128. ImgSize: Integer;
  7129. begin
  7130. result := inherited FlipHorz;
  7131. if Assigned(Data) then begin
  7132. SourceData := Data;
  7133. ImgSize := Height * fRowSize;
  7134. GetMem(DestData, ImgSize);
  7135. try
  7136. TempDestData := DestData;
  7137. Dec(TempDestData, fRowSize + fPixelSize);
  7138. for Row := 0 to Height -1 do begin
  7139. Inc(TempDestData, fRowSize * 2);
  7140. for Col := 0 to Width -1 do begin
  7141. Move(SourceData^, TempDestData^, fPixelSize);
  7142. Inc(SourceData, fPixelSize);
  7143. Dec(TempDestData, fPixelSize);
  7144. end;
  7145. end;
  7146. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7147. result := true;
  7148. except
  7149. if Assigned(DestData) then
  7150. FreeMem(DestData);
  7151. raise;
  7152. end;
  7153. end;
  7154. end;
  7155. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7156. function TglBitmap2D.FlipVert: Boolean;
  7157. var
  7158. Row: Integer;
  7159. TempDestData, DestData, SourceData: PByte;
  7160. begin
  7161. result := inherited FlipVert;
  7162. if Assigned(Data) then begin
  7163. SourceData := Data;
  7164. GetMem(DestData, Height * fRowSize);
  7165. try
  7166. TempDestData := DestData;
  7167. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7168. for Row := 0 to Height -1 do begin
  7169. Move(SourceData^, TempDestData^, fRowSize);
  7170. Dec(TempDestData, fRowSize);
  7171. Inc(SourceData, fRowSize);
  7172. end;
  7173. SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method
  7174. result := true;
  7175. except
  7176. if Assigned(DestData) then
  7177. FreeMem(DestData);
  7178. raise;
  7179. end;
  7180. end;
  7181. end;
  7182. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7183. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7184. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7185. type
  7186. TMatrixItem = record
  7187. X, Y: Integer;
  7188. W: Single;
  7189. end;
  7190. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7191. TglBitmapToNormalMapRec = Record
  7192. Scale: Single;
  7193. Heights: array of Single;
  7194. MatrixU : array of TMatrixItem;
  7195. MatrixV : array of TMatrixItem;
  7196. end;
  7197. const
  7198. ONE_OVER_255 = 1 / 255;
  7199. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7200. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7201. var
  7202. Val: Single;
  7203. begin
  7204. with FuncRec do begin
  7205. Val :=
  7206. Source.Data.r * LUMINANCE_WEIGHT_R +
  7207. Source.Data.g * LUMINANCE_WEIGHT_G +
  7208. Source.Data.b * LUMINANCE_WEIGHT_B;
  7209. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7210. end;
  7211. end;
  7212. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7213. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7214. begin
  7215. with FuncRec do
  7216. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7217. end;
  7218. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7219. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7220. type
  7221. TVec = Array[0..2] of Single;
  7222. var
  7223. Idx: Integer;
  7224. du, dv: Double;
  7225. Len: Single;
  7226. Vec: TVec;
  7227. function GetHeight(X, Y: Integer): Single;
  7228. begin
  7229. with FuncRec do begin
  7230. X := Max(0, Min(Size.X -1, X));
  7231. Y := Max(0, Min(Size.Y -1, Y));
  7232. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7233. end;
  7234. end;
  7235. begin
  7236. with FuncRec do begin
  7237. with PglBitmapToNormalMapRec(Args)^ do begin
  7238. du := 0;
  7239. for Idx := Low(MatrixU) to High(MatrixU) do
  7240. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7241. dv := 0;
  7242. for Idx := Low(MatrixU) to High(MatrixU) do
  7243. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7244. Vec[0] := -du * Scale;
  7245. Vec[1] := -dv * Scale;
  7246. Vec[2] := 1;
  7247. end;
  7248. // Normalize
  7249. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7250. if Len <> 0 then begin
  7251. Vec[0] := Vec[0] * Len;
  7252. Vec[1] := Vec[1] * Len;
  7253. Vec[2] := Vec[2] * Len;
  7254. end;
  7255. // Farbe zuweisem
  7256. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7257. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7258. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7259. end;
  7260. end;
  7261. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7262. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7263. var
  7264. Rec: TglBitmapToNormalMapRec;
  7265. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7266. begin
  7267. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7268. Matrix[Index].X := X;
  7269. Matrix[Index].Y := Y;
  7270. Matrix[Index].W := W;
  7271. end;
  7272. end;
  7273. begin
  7274. if TFormatDescriptor.Get(Format).IsCompressed then
  7275. raise EglBitmapUnsupportedFormat.Create(Format);
  7276. if aScale > 100 then
  7277. Rec.Scale := 100
  7278. else if aScale < -100 then
  7279. Rec.Scale := -100
  7280. else
  7281. Rec.Scale := aScale;
  7282. SetLength(Rec.Heights, Width * Height);
  7283. try
  7284. case aFunc of
  7285. nm4Samples: begin
  7286. SetLength(Rec.MatrixU, 2);
  7287. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7288. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7289. SetLength(Rec.MatrixV, 2);
  7290. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7291. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7292. end;
  7293. nmSobel: begin
  7294. SetLength(Rec.MatrixU, 6);
  7295. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7296. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7297. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7298. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7299. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7300. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7301. SetLength(Rec.MatrixV, 6);
  7302. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7303. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7304. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7305. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7306. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7307. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7308. end;
  7309. nm3x3: begin
  7310. SetLength(Rec.MatrixU, 6);
  7311. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7312. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7313. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7314. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7315. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7316. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7317. SetLength(Rec.MatrixV, 6);
  7318. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7319. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7320. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7321. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7322. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7323. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7324. end;
  7325. nm5x5: begin
  7326. SetLength(Rec.MatrixU, 20);
  7327. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7328. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7329. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7330. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7331. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7332. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7333. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7334. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7335. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7336. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7337. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7338. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7339. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7340. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7341. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7342. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7343. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7344. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7345. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7346. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7347. SetLength(Rec.MatrixV, 20);
  7348. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7349. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7350. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7351. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7352. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7353. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7354. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7355. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7356. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7357. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7358. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7359. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7360. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7361. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7362. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7363. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7364. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7365. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7366. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7367. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7368. end;
  7369. end;
  7370. // Daten Sammeln
  7371. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7372. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7373. else
  7374. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7375. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7376. finally
  7377. SetLength(Rec.Heights, 0);
  7378. end;
  7379. end;
  7380. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7381. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7382. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7383. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7384. begin
  7385. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7386. end;
  7387. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7388. procedure TglBitmapCubeMap.AfterConstruction;
  7389. begin
  7390. inherited;
  7391. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7392. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7393. SetWrap;
  7394. Target := GL_TEXTURE_CUBE_MAP;
  7395. fGenMode := GL_REFLECTION_MAP;
  7396. end;
  7397. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7398. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7399. var
  7400. BuildWithGlu: Boolean;
  7401. TexSize: Integer;
  7402. begin
  7403. if (aTestTextureSize) then begin
  7404. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7405. if (Height > TexSize) or (Width > TexSize) then
  7406. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7407. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7408. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7409. end;
  7410. if (ID = 0) then
  7411. CreateID;
  7412. SetupParameters(BuildWithGlu);
  7413. UploadData(aCubeTarget, BuildWithGlu);
  7414. end;
  7415. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7416. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
  7417. begin
  7418. inherited Bind (aEnableTextureUnit);
  7419. if aEnableTexCoordsGen then begin
  7420. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7421. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7422. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7423. glEnable(GL_TEXTURE_GEN_S);
  7424. glEnable(GL_TEXTURE_GEN_T);
  7425. glEnable(GL_TEXTURE_GEN_R);
  7426. end;
  7427. end;
  7428. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7429. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
  7430. begin
  7431. inherited Unbind(aDisableTextureUnit);
  7432. if aDisableTexCoordsGen then begin
  7433. glDisable(GL_TEXTURE_GEN_S);
  7434. glDisable(GL_TEXTURE_GEN_T);
  7435. glDisable(GL_TEXTURE_GEN_R);
  7436. end;
  7437. end;
  7438. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7439. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7440. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7441. type
  7442. TVec = Array[0..2] of Single;
  7443. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7444. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7445. TglBitmapNormalMapRec = record
  7446. HalfSize : Integer;
  7447. Func: TglBitmapNormalMapGetVectorFunc;
  7448. end;
  7449. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7450. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7451. begin
  7452. aVec[0] := aHalfSize;
  7453. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7454. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7455. end;
  7456. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7457. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7458. begin
  7459. aVec[0] := - aHalfSize;
  7460. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7461. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7462. end;
  7463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7464. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7465. begin
  7466. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7467. aVec[1] := aHalfSize;
  7468. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7469. end;
  7470. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7471. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7472. begin
  7473. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7474. aVec[1] := - aHalfSize;
  7475. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7476. end;
  7477. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7478. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7479. begin
  7480. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7481. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7482. aVec[2] := aHalfSize;
  7483. end;
  7484. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7485. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7486. begin
  7487. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7488. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7489. aVec[2] := - aHalfSize;
  7490. end;
  7491. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7492. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7493. var
  7494. i: Integer;
  7495. Vec: TVec;
  7496. Len: Single;
  7497. begin
  7498. with FuncRec do begin
  7499. with PglBitmapNormalMapRec(Args)^ do begin
  7500. Func(Vec, Position, HalfSize);
  7501. // Normalize
  7502. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7503. if Len <> 0 then begin
  7504. Vec[0] := Vec[0] * Len;
  7505. Vec[1] := Vec[1] * Len;
  7506. Vec[2] := Vec[2] * Len;
  7507. end;
  7508. // Scale Vector and AddVectro
  7509. Vec[0] := Vec[0] * 0.5 + 0.5;
  7510. Vec[1] := Vec[1] * 0.5 + 0.5;
  7511. Vec[2] := Vec[2] * 0.5 + 0.5;
  7512. end;
  7513. // Set Color
  7514. for i := 0 to 2 do
  7515. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7516. end;
  7517. end;
  7518. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7519. procedure TglBitmapNormalMap.AfterConstruction;
  7520. begin
  7521. inherited;
  7522. fGenMode := GL_NORMAL_MAP;
  7523. end;
  7524. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7525. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7526. var
  7527. Rec: TglBitmapNormalMapRec;
  7528. SizeRec: TglBitmapPixelPosition;
  7529. begin
  7530. Rec.HalfSize := aSize div 2;
  7531. FreeDataAfterGenTexture := false;
  7532. SizeRec.Fields := [ffX, ffY];
  7533. SizeRec.X := aSize;
  7534. SizeRec.Y := aSize;
  7535. // Positive X
  7536. Rec.Func := glBitmapNormalMapPosX;
  7537. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7538. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7539. // Negative X
  7540. Rec.Func := glBitmapNormalMapNegX;
  7541. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7542. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7543. // Positive Y
  7544. Rec.Func := glBitmapNormalMapPosY;
  7545. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7546. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7547. // Negative Y
  7548. Rec.Func := glBitmapNormalMapNegY;
  7549. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7550. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7551. // Positive Z
  7552. Rec.Func := glBitmapNormalMapPosZ;
  7553. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7554. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7555. // Negative Z
  7556. Rec.Func := glBitmapNormalMapNegZ;
  7557. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7558. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7559. end;
  7560. initialization
  7561. glBitmapSetDefaultFormat (tfEmpty);
  7562. glBitmapSetDefaultMipmap (mmMipmap);
  7563. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7564. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7565. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7566. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7567. glBitmapSetDefaultDeleteTextureOnFree (true);
  7568. TFormatDescriptor.Init;
  7569. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7570. OpenGLInitialized := false;
  7571. InitOpenGLCS := TCriticalSection.Create;
  7572. {$ENDIF}
  7573. finalization
  7574. TFormatDescriptor.Finalize;
  7575. {$IFDEF GLB_NATIVE_OGL}
  7576. if Assigned(GL_LibHandle) then
  7577. glbFreeLibrary(GL_LibHandle);
  7578. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7579. if Assigned(GLU_LibHandle) then
  7580. glbFreeLibrary(GLU_LibHandle);
  7581. FreeAndNil(InitOpenGLCS);
  7582. {$ENDIF}
  7583. {$ENDIF}
  7584. end.