Non puoi selezionare più di 25 argomenti Gli argomenti devono iniziare con una lettera o un numero, possono includere trattini ('-') e possono essere lunghi fino a 35 caratteri.

8577 righe
295 KiB

  1. {***********************************************************
  2. glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  3. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  4. modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
  5. ------------------------------------------------------------
  6. The contents of this file are used with permission, subject to
  7. the Mozilla Public License Version 1.1 (the "License"); you may
  8. not use this file except in compliance with the License. You may
  9. obtain a copy of the License at
  10. http://www.mozilla.org/MPL/MPL-1.1.html
  11. ------------------------------------------------------------
  12. Version 3.0.0 unstable
  13. ------------------------------------------------------------
  14. History
  15. 20-11-2013
  16. - refactoring of the complete library
  17. 21-03-2010
  18. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  19. then it's your problem if that isn't true. This prevents the unit for incompatibility
  20. with newer versions of Delphi.
  21. - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  22. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  23. 10-08-2008
  24. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  25. - Additional Datapointer for functioninterface now has the name CustomData
  26. 24-07-2008
  27. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  28. - If you load an texture from an file the property Filename will be set to the name of the file
  29. - Three new properties to attach custom data to the Texture objects
  30. - CustomName (free for use string)
  31. - CustomNameW (free for use widestring)
  32. - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  33. 27-05-2008
  34. - RLE TGAs loaded much faster
  35. 26-05-2008
  36. - fixed some problem with reading RLE TGAs.
  37. 21-05-2008
  38. - function clone now only copys data if it's assigned and now it also copies the ID
  39. - it seems that lazarus dont like comments in comments.
  40. 01-05-2008
  41. - It's possible to set the id of the texture
  42. - define GLB_NO_NATIVE_GL deactivated by default
  43. 27-04-2008
  44. - Now supports the following libraries
  45. - SDL and SDL_image
  46. - libPNG
  47. - libJPEG
  48. - Linux compatibillity via free pascal compatibility (delphi sources optional)
  49. - BMPs now loaded manuel
  50. - Large restructuring
  51. - Property DataPtr now has the name Data
  52. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  53. - Unused Depth removed
  54. - Function FreeData to freeing image data added
  55. 24-10-2007
  56. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  57. 15-11-2006
  58. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  59. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  60. - Function ReadOpenGLExtension is now only intern
  61. 29-06-2006
  62. - pngimage now disabled by default like all other versions.
  63. 26-06-2006
  64. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  65. 22-06-2006
  66. - Fixed some Problem with Delphi 5
  67. - Now uses the newest version of pngimage. Makes saving pngs much easier.
  68. 22-03-2006
  69. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  70. 09-03-2006
  71. - Internal Format ifDepth8 added
  72. - function GrabScreen now supports all uncompressed formats
  73. 31-01-2006
  74. - AddAlphaFromglBitmap implemented
  75. 29-12-2005
  76. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  77. 28-12-2005
  78. - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  79. property Width, Height, Depth are still existing and new property Dimension are avail
  80. 11-12-2005
  81. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  82. 19-10-2005
  83. - Added function GrabScreen to class TglBitmap2D
  84. 18-10-2005
  85. - Added support to Save images
  86. - Added function Clone to Clone Instance
  87. 11-10-2005
  88. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  89. Usefull for Future
  90. - Several speed optimizations
  91. 09-10-2005
  92. - Internal structure change. Loading of TGA, PNG and DDS improved.
  93. Data, format and size will now set directly with SetDataPtr.
  94. - AddFunc now works with all Types of Images and Formats
  95. - Some Funtions moved to Baseclass TglBitmap
  96. 06-10-2005
  97. - Added Support to decompress DXT3 and DXT5 compressed Images.
  98. - Added Mapping to convert data from one format into an other.
  99. 05-10-2005
  100. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  101. supported Input format (supported by GetPixel) into any uncompresed Format
  102. - Added Support to decompress DXT1 compressed Images.
  103. - SwapColors replaced by ConvertTo
  104. 04-10-2005
  105. - Added Support for compressed DDSs
  106. - Added new internal formats (DXT1, DXT3, DXT5)
  107. 29-09-2005
  108. - Parameter Components renamed to InternalFormat
  109. 23-09-2005
  110. - Some AllocMem replaced with GetMem (little speed change)
  111. - better exception handling. Better protection from memory leaks.
  112. 22-09-2005
  113. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
  114. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
  115. 07-09-2005
  116. - Added support for Grayscale textures
  117. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
  118. 10-07-2005
  119. - Added support for GL_VERSION_2_0
  120. - Added support for GL_EXT_texture_filter_anisotropic
  121. 04-07-2005
  122. - Function FillWithColor fills the Image with one Color
  123. - Function LoadNormalMap added
  124. 30-06-2005
  125. - ToNormalMap allows to Create an NormalMap from the Alphachannel
  126. - ToNormalMap now supports Sobel (nmSobel) function.
  127. 29-06-2005
  128. - support for RLE Compressed RGB TGAs added
  129. 28-06-2005
  130. - Class TglBitmapNormalMap added to support Normalmap generation
  131. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
  132. 3 Filters are supported. (4 Samples, 3x3 and 5x5)
  133. 16-06-2005
  134. - Method LoadCubeMapClass removed
  135. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
  136. - virtual abstract method GenTexture in class TglBitmap now is protected
  137. 12-06-2005
  138. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
  139. 10-06-2005
  140. - little enhancement for IsPowerOfTwo
  141. - TglBitmap1D.GenTexture now tests NPOT Textures
  142. 06-06-2005
  143. - some little name changes. All properties or function with Texture in name are
  144. now without texture in name. We have allways texture so we dosn't name it.
  145. 03-06-2005
  146. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
  147. TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
  148. 02-06-2005
  149. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
  150. 25-04-2005
  151. - Function Unbind added
  152. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
  153. 21-04-2005
  154. - class TglBitmapCubeMap added (allows to Create Cubemaps)
  155. 29-03-2005
  156. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
  157. To Enable png's use the define pngimage
  158. 22-03-2005
  159. - New Functioninterface added
  160. - Function GetPixel added
  161. 27-11-2004
  162. - Property BuildMipMaps renamed to MipMap
  163. 21-11-2004
  164. - property Name removed.
  165. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
  166. 22-05-2004
  167. - property name added. Only used in glForms!
  168. 26-11-2003
  169. - property FreeDataAfterGenTexture is now available as default (default = true)
  170. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
  171. - function MoveMemory replaced with function Move (little speed change)
  172. - several calculations stored in variables (little speed change)
  173. 29-09-2003
  174. - property BuildMipsMaps added (default = true)
  175. if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
  176. - property FreeDataAfterGenTexture added (default = true)
  177. if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
  178. - parameter DisableOtherTextureUnits of Bind removed
  179. - parameter FreeDataAfterGeneration of GenTextures removed
  180. 12-09-2003
  181. - TglBitmap dosn't delete data if class was destroyed (fixed)
  182. 09-09-2003
  183. - Bind now enables TextureUnits (by params)
  184. - GenTextures can leave data (by param)
  185. - LoadTextures now optimal
  186. 03-09-2003
  187. - Performance optimization in AddFunc
  188. - procedure Bind moved to subclasses
  189. - Added new Class TglBitmap1D to support real OpenGL 1D Textures
  190. 19-08-2003
  191. - Texturefilter and texturewrap now also as defaults
  192. Minfilter = GL_LINEAR_MIPMAP_LINEAR
  193. Magfilter = GL_LINEAR
  194. Wrap(str) = GL_CLAMP_TO_EDGE
  195. - Added new format tfCompressed to create a compressed texture.
  196. - propertys IsCompressed, TextureSize and IsResident added
  197. IsCompressed and TextureSize only contains data from level 0
  198. 18-08-2003
  199. - Added function AddFunc to add PerPixelEffects to Image
  200. - LoadFromFunc now based on AddFunc
  201. - Invert now based on AddFunc
  202. - SwapColors now based on AddFunc
  203. 16-08-2003
  204. - Added function FlipHorz
  205. 15-08-2003
  206. - Added function LaodFromFunc to create images with function
  207. - Added function FlipVert
  208. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
  209. 29-07-2003
  210. - Added Alphafunctions to calculate alpha per function
  211. - Added Alpha from ColorKey using alphafunctions
  212. 28-07-2003
  213. - First full functionally Version of glBitmap
  214. - Support for 24Bit and 32Bit TGA Pictures added
  215. 25-07-2003
  216. - begin of programming
  217. ***********************************************************}
  218. unit glBitmap;
  219. // Please uncomment the defines below to configure the glBitmap to your preferences.
  220. // If you have configured the unit you can uncomment the warning above.
  221. {$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  223. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  225. // activate to enable build-in OpenGL support with statically linked methods
  226. // use dglOpenGL.pas if not enabled
  227. {.$DEFINE GLB_NATIVE_OGL_STATIC}
  228. // activate to enable build-in OpenGL support with dynamically linked methods
  229. // use dglOpenGL.pas if not enabled
  230. {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
  231. // activate to enable the support for SDL_surfaces
  232. {.$DEFINE GLB_SDL}
  233. // activate to enable the support for TBitmap from Delphi (not lazarus)
  234. {.$DEFINE GLB_DELPHI}
  235. // activate to enable the support for TLazIntfImage from Lazarus
  236. {.$DEFINE GLB_LAZARUS}
  237. // activate to enable the support of SDL_image to load files. (READ ONLY)
  238. // If you enable SDL_image all other libraries will be ignored!
  239. {.$DEFINE GLB_SDL_IMAGE}
  240. // activate to enable Lazarus TPortableNetworkGraphic support
  241. // if you enable this pngImage and libPNG will be ignored
  242. {.$DEFINE GLB_LAZ_PNG}
  243. // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
  244. // if you enable pngimage the libPNG will be ignored
  245. {.$DEFINE GLB_PNGIMAGE}
  246. // activate to use the libPNG -> http://www.libpng.org/
  247. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
  248. {.$DEFINE GLB_LIB_PNG}
  249. // activate to enable Lazarus TJPEGImage support
  250. // if you enable this delphi jpegs and libJPEG will be ignored
  251. {.$DEFINE GLB_LAZ_JPEG}
  252. // if you enable delphi jpegs the libJPEG will be ignored
  253. {.$DEFINE GLB_DELPHI_JPEG}
  254. // activate to use the libJPEG -> http://www.ijg.org/
  255. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
  256. {.$DEFINE GLB_LIB_JPEG}
  257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  258. // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  259. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  260. // Delphi Versions
  261. {$IFDEF fpc}
  262. {$MODE Delphi}
  263. {$IFDEF CPUI386}
  264. {$DEFINE CPU386}
  265. {$ASMMODE INTEL}
  266. {$ENDIF}
  267. {$IFNDEF WINDOWS}
  268. {$linklib c}
  269. {$ENDIF}
  270. {$ENDIF}
  271. // Operation System
  272. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  273. {$DEFINE GLB_WIN}
  274. {$ELSEIF DEFINED(LINUX)}
  275. {$DEFINE GLB_LINUX}
  276. {$IFEND}
  277. // native OpenGL Support
  278. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  279. {$DEFINE GLB_NATIVE_OGL}
  280. {$IFEND}
  281. // checking define combinations
  282. //SDL Image
  283. {$IFDEF GLB_SDL_IMAGE}
  284. {$IFNDEF GLB_SDL}
  285. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  286. {$DEFINE GLB_SDL}
  287. {$ENDIF}
  288. {$IFDEF GLB_LAZ_PNG}
  289. {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  290. {$undef GLB_LAZ_PNG}
  291. {$ENDIF}
  292. {$IFDEF GLB_PNGIMAGE}
  293. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  294. {$undef GLB_PNGIMAGE}
  295. {$ENDIF}
  296. {$IFDEF GLB_LAZ_JPEG}
  297. {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  298. {$undef GLB_LAZ_JPEG}
  299. {$ENDIF}
  300. {$IFDEF GLB_DELPHI_JPEG}
  301. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  302. {$undef GLB_DELPHI_JPEG}
  303. {$ENDIF}
  304. {$IFDEF GLB_LIB_PNG}
  305. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  306. {$undef GLB_LIB_PNG}
  307. {$ENDIF}
  308. {$IFDEF GLB_LIB_JPEG}
  309. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  310. {$undef GLB_LIB_JPEG}
  311. {$ENDIF}
  312. {$DEFINE GLB_SUPPORT_PNG_READ}
  313. {$DEFINE GLB_SUPPORT_JPEG_READ}
  314. {$ENDIF}
  315. // Lazarus TPortableNetworkGraphic
  316. {$IFDEF GLB_LAZ_PNG}
  317. {$IFNDEF GLB_LAZARUS}
  318. {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
  319. {$DEFINE GLB_LAZARUS}
  320. {$ENDIF}
  321. {$IFDEF GLB_PNGIMAGE}
  322. {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  323. {$undef GLB_PNGIMAGE}
  324. {$ENDIF}
  325. {$IFDEF GLB_LIB_PNG}
  326. {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  327. {$undef GLB_LIB_PNG}
  328. {$ENDIF}
  329. {$DEFINE GLB_SUPPORT_PNG_READ}
  330. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  331. {$ENDIF}
  332. // PNG Image
  333. {$IFDEF GLB_PNGIMAGE}
  334. {$IFDEF GLB_LIB_PNG}
  335. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  336. {$undef GLB_LIB_PNG}
  337. {$ENDIF}
  338. {$DEFINE GLB_SUPPORT_PNG_READ}
  339. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  340. {$ENDIF}
  341. // libPNG
  342. {$IFDEF GLB_LIB_PNG}
  343. {$DEFINE GLB_SUPPORT_PNG_READ}
  344. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  345. {$ENDIF}
  346. // Lazarus TJPEGImage
  347. {$IFDEF GLB_LAZ_JPEG}
  348. {$IFNDEF GLB_LAZARUS}
  349. {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
  350. {$DEFINE GLB_LAZARUS}
  351. {$ENDIF}
  352. {$IFDEF GLB_DELPHI_JPEG}
  353. {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
  354. {$undef GLB_DELPHI_JPEG}
  355. {$ENDIF}
  356. {$IFDEF GLB_LIB_JPEG}
  357. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
  358. {$undef GLB_LIB_JPEG}
  359. {$ENDIF}
  360. {$DEFINE GLB_SUPPORT_JPEG_READ}
  361. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  362. {$ENDIF}
  363. // JPEG Image
  364. {$IFDEF GLB_DELPHI_JPEG}
  365. {$IFDEF GLB_LIB_JPEG}
  366. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  367. {$undef GLB_LIB_JPEG}
  368. {$ENDIF}
  369. {$DEFINE GLB_SUPPORT_JPEG_READ}
  370. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  371. {$ENDIF}
  372. // libJPEG
  373. {$IFDEF GLB_LIB_JPEG}
  374. {$DEFINE GLB_SUPPORT_JPEG_READ}
  375. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  376. {$ENDIF}
  377. // native OpenGL
  378. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  379. {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
  380. {$IFEND}
  381. // general options
  382. {$EXTENDEDSYNTAX ON}
  383. {$LONGSTRINGS ON}
  384. {$ALIGN ON}
  385. {$IFNDEF FPC}
  386. {$OPTIMIZATION ON}
  387. {$ENDIF}
  388. interface
  389. uses
  390. {$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
  391. {$IF DEFINED(GLB_WIN) AND
  392. (DEFINED(GLB_NATIVE_OGL) OR
  393. DEFINED(GLB_DELPHI))} windows, {$IFEND}
  394. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  395. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  396. {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$ENDIF}
  397. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  398. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  399. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  400. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  401. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  402. Classes, SysUtils;
  403. {$IFDEF GLB_NATIVE_OGL}
  404. const
  405. GL_TRUE = 1;
  406. GL_FALSE = 0;
  407. GL_ZERO = 0;
  408. GL_ONE = 1;
  409. GL_VERSION = $1F02;
  410. GL_EXTENSIONS = $1F03;
  411. GL_TEXTURE_1D = $0DE0;
  412. GL_TEXTURE_2D = $0DE1;
  413. GL_TEXTURE_RECTANGLE = $84F5;
  414. GL_NORMAL_MAP = $8511;
  415. GL_TEXTURE_CUBE_MAP = $8513;
  416. GL_REFLECTION_MAP = $8512;
  417. GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
  418. GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
  419. GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
  420. GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
  421. GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
  422. GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
  423. GL_TEXTURE_WIDTH = $1000;
  424. GL_TEXTURE_HEIGHT = $1001;
  425. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  426. GL_TEXTURE_SWIZZLE_RGBA = $8E46;
  427. GL_S = $2000;
  428. GL_T = $2001;
  429. GL_R = $2002;
  430. GL_Q = $2003;
  431. GL_TEXTURE_GEN_S = $0C60;
  432. GL_TEXTURE_GEN_T = $0C61;
  433. GL_TEXTURE_GEN_R = $0C62;
  434. GL_TEXTURE_GEN_Q = $0C63;
  435. GL_RED = $1903;
  436. GL_GREEN = $1904;
  437. GL_BLUE = $1905;
  438. GL_ALPHA = $1906;
  439. GL_ALPHA4 = $803B;
  440. GL_ALPHA8 = $803C;
  441. GL_ALPHA12 = $803D;
  442. GL_ALPHA16 = $803E;
  443. GL_LUMINANCE = $1909;
  444. GL_LUMINANCE4 = $803F;
  445. GL_LUMINANCE8 = $8040;
  446. GL_LUMINANCE12 = $8041;
  447. GL_LUMINANCE16 = $8042;
  448. GL_LUMINANCE_ALPHA = $190A;
  449. GL_LUMINANCE4_ALPHA4 = $8043;
  450. GL_LUMINANCE6_ALPHA2 = $8044;
  451. GL_LUMINANCE8_ALPHA8 = $8045;
  452. GL_LUMINANCE12_ALPHA4 = $8046;
  453. GL_LUMINANCE12_ALPHA12 = $8047;
  454. GL_LUMINANCE16_ALPHA16 = $8048;
  455. GL_RGB = $1907;
  456. GL_BGR = $80E0;
  457. GL_R3_G3_B2 = $2A10;
  458. GL_RGB4 = $804F;
  459. GL_RGB5 = $8050;
  460. GL_RGB565 = $8D62;
  461. GL_RGB8 = $8051;
  462. GL_RGB10 = $8052;
  463. GL_RGB12 = $8053;
  464. GL_RGB16 = $8054;
  465. GL_RGBA = $1908;
  466. GL_BGRA = $80E1;
  467. GL_RGBA2 = $8055;
  468. GL_RGBA4 = $8056;
  469. GL_RGB5_A1 = $8057;
  470. GL_RGBA8 = $8058;
  471. GL_RGB10_A2 = $8059;
  472. GL_RGBA12 = $805A;
  473. GL_RGBA16 = $805B;
  474. GL_DEPTH_COMPONENT = $1902;
  475. GL_DEPTH_COMPONENT16 = $81A5;
  476. GL_DEPTH_COMPONENT24 = $81A6;
  477. GL_DEPTH_COMPONENT32 = $81A7;
  478. GL_COMPRESSED_RGB = $84ED;
  479. GL_COMPRESSED_RGBA = $84EE;
  480. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  481. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  482. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  483. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  484. GL_UNSIGNED_BYTE = $1401;
  485. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  486. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  487. GL_UNSIGNED_SHORT = $1403;
  488. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  489. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  490. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  491. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  492. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  493. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  494. GL_UNSIGNED_INT = $1405;
  495. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  496. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  497. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  498. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  499. { Texture Filter }
  500. GL_TEXTURE_MAG_FILTER = $2800;
  501. GL_TEXTURE_MIN_FILTER = $2801;
  502. GL_NEAREST = $2600;
  503. GL_NEAREST_MIPMAP_NEAREST = $2700;
  504. GL_NEAREST_MIPMAP_LINEAR = $2702;
  505. GL_LINEAR = $2601;
  506. GL_LINEAR_MIPMAP_NEAREST = $2701;
  507. GL_LINEAR_MIPMAP_LINEAR = $2703;
  508. { Texture Wrap }
  509. GL_TEXTURE_WRAP_S = $2802;
  510. GL_TEXTURE_WRAP_T = $2803;
  511. GL_TEXTURE_WRAP_R = $8072;
  512. GL_CLAMP = $2900;
  513. GL_REPEAT = $2901;
  514. GL_CLAMP_TO_EDGE = $812F;
  515. GL_CLAMP_TO_BORDER = $812D;
  516. GL_MIRRORED_REPEAT = $8370;
  517. { Other }
  518. GL_GENERATE_MIPMAP = $8191;
  519. GL_TEXTURE_BORDER_COLOR = $1004;
  520. GL_MAX_TEXTURE_SIZE = $0D33;
  521. GL_PACK_ALIGNMENT = $0D05;
  522. GL_UNPACK_ALIGNMENT = $0CF5;
  523. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  524. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  525. GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
  526. GL_TEXTURE_GEN_MODE = $2500;
  527. {$IF DEFINED(GLB_WIN)}
  528. libglu = 'glu32.dll';
  529. libopengl = 'opengl32.dll';
  530. {$ELSEIF DEFINED(GLB_LINUX)}
  531. libglu = 'libGLU.so.1';
  532. libopengl = 'libGL.so.1';
  533. {$IFEND}
  534. type
  535. GLboolean = BYTEBOOL;
  536. GLint = Integer;
  537. GLsizei = Integer;
  538. GLuint = Cardinal;
  539. GLfloat = Single;
  540. GLenum = Cardinal;
  541. PGLvoid = Pointer;
  542. PGLboolean = ^GLboolean;
  543. PGLint = ^GLint;
  544. PGLuint = ^GLuint;
  545. PGLfloat = ^GLfloat;
  546. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  547. TglCompressedTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  548. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  549. {$IF DEFINED(GLB_WIN)}
  550. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  551. {$ELSEIF DEFINED(GLB_LINUX)}
  552. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  553. TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
  554. {$IFEND}
  555. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  556. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  557. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  558. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  559. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  560. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  561. TglTexParameteriv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  562. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  563. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  564. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  565. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  566. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  567. TglTexGeni = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  568. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  569. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  570. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  571. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  572. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  573. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  574. TglTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  575. TglTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  576. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  577. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  578. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  579. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  580. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  581. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  582. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  583. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  584. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  585. procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  586. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  587. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  588. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  589. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  590. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  591. procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  592. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  593. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  594. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  595. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  596. procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  597. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  598. procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  599. procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  600. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  601. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  602. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  603. {$IFEND}
  604. var
  605. GL_VERSION_1_2,
  606. GL_VERSION_1_3,
  607. GL_VERSION_1_4,
  608. GL_VERSION_2_0,
  609. GL_VERSION_3_3,
  610. GL_SGIS_generate_mipmap,
  611. GL_ARB_texture_border_clamp,
  612. GL_ARB_texture_mirrored_repeat,
  613. GL_ARB_texture_rectangle,
  614. GL_ARB_texture_non_power_of_two,
  615. GL_ARB_texture_swizzle,
  616. GL_ARB_texture_cube_map,
  617. GL_IBM_texture_mirrored_repeat,
  618. GL_NV_texture_rectangle,
  619. GL_EXT_texture_edge_clamp,
  620. GL_EXT_texture_rectangle,
  621. GL_EXT_texture_swizzle,
  622. GL_EXT_texture_cube_map,
  623. GL_EXT_texture_filter_anisotropic: Boolean;
  624. glCompressedTexImage1D: TglCompressedTexImage1D;
  625. glCompressedTexImage2D: TglCompressedTexImage2D;
  626. glGetCompressedTexImage: TglGetCompressedTexImage;
  627. {$IF DEFINED(GLB_WIN)}
  628. wglGetProcAddress: TwglGetProcAddress;
  629. {$ELSEIF DEFINED(GLB_LINUX)}
  630. glXGetProcAddress: TglXGetProcAddress;
  631. glXGetProcAddressARB: TglXGetProcAddress;
  632. {$IFEND}
  633. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  634. glEnable: TglEnable;
  635. glDisable: TglDisable;
  636. glGetString: TglGetString;
  637. glGetIntegerv: TglGetIntegerv;
  638. glTexParameteri: TglTexParameteri;
  639. glTexParameteriv: TglTexParameteriv;
  640. glTexParameterfv: TglTexParameterfv;
  641. glGetTexParameteriv: TglGetTexParameteriv;
  642. glGetTexParameterfv: TglGetTexParameterfv;
  643. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  644. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  645. glTexGeni: TglTexGeni;
  646. glGenTextures: TglGenTextures;
  647. glBindTexture: TglBindTexture;
  648. glDeleteTextures: TglDeleteTextures;
  649. glAreTexturesResident: TglAreTexturesResident;
  650. glReadPixels: TglReadPixels;
  651. glPixelStorei: TglPixelStorei;
  652. glTexImage1D: TglTexImage1D;
  653. glTexImage2D: TglTexImage2D;
  654. glGetTexImage: TglGetTexImage;
  655. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  656. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  657. {$ENDIF}
  658. {$ENDIF}
  659. type
  660. ////////////////////////////////////////////////////////////////////////////////////////////////////
  661. TglBitmapFormat = (
  662. tfEmpty = 0, //must be smallest value!
  663. tfAlpha4,
  664. tfAlpha8,
  665. tfAlpha12,
  666. tfAlpha16,
  667. tfLuminance4,
  668. tfLuminance8,
  669. tfLuminance12,
  670. tfLuminance16,
  671. tfLuminance4Alpha4,
  672. tfLuminance6Alpha2,
  673. tfLuminance8Alpha8,
  674. tfLuminance12Alpha4,
  675. tfLuminance12Alpha12,
  676. tfLuminance16Alpha16,
  677. tfR3G3B2,
  678. tfRGB4,
  679. tfR5G6B5,
  680. tfRGB5,
  681. tfRGB8,
  682. tfRGB10,
  683. tfRGB12,
  684. tfRGB16,
  685. tfRGBA2,
  686. tfRGBA4,
  687. tfRGB5A1,
  688. tfRGBA8,
  689. tfRGB10A2,
  690. tfRGBA12,
  691. tfRGBA16,
  692. tfBGR4,
  693. tfB5G6R5,
  694. tfBGR5,
  695. tfBGR8,
  696. tfBGR10,
  697. tfBGR12,
  698. tfBGR16,
  699. tfBGRA2,
  700. tfBGRA4,
  701. tfBGR5A1,
  702. tfBGRA8,
  703. tfBGR10A2,
  704. tfBGRA12,
  705. tfBGRA16,
  706. tfDepth16,
  707. tfDepth24,
  708. tfDepth32,
  709. tfS3tcDtx1RGBA,
  710. tfS3tcDtx3RGBA,
  711. tfS3tcDtx5RGBA
  712. );
  713. TglBitmapFileType = (
  714. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  715. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  716. ftDDS,
  717. ftTGA,
  718. ftBMP);
  719. TglBitmapFileTypes = set of TglBitmapFileType;
  720. TglBitmapMipMap = (
  721. mmNone,
  722. mmMipmap,
  723. mmMipmapGlu);
  724. TglBitmapNormalMapFunc = (
  725. nm4Samples,
  726. nmSobel,
  727. nm3x3,
  728. nm5x5);
  729. ////////////////////////////////////////////////////////////////////////////////////////////////////
  730. EglBitmap = class(Exception);
  731. EglBitmapNotSupported = class(Exception);
  732. EglBitmapSizeToLarge = class(EglBitmap);
  733. EglBitmapNonPowerOfTwo = class(EglBitmap);
  734. EglBitmapUnsupportedFormat = class(EglBitmap)
  735. public
  736. constructor Create(const aFormat: TglBitmapFormat); overload;
  737. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  738. end;
  739. ////////////////////////////////////////////////////////////////////////////////////////////////////
  740. TglBitmapColorRec = packed record
  741. case Integer of
  742. 0: (r, g, b, a: Cardinal);
  743. 1: (arr: array[0..3] of Cardinal);
  744. end;
  745. TglBitmapPixelData = packed record
  746. Data, Range: TglBitmapColorRec;
  747. Format: TglBitmapFormat;
  748. end;
  749. PglBitmapPixelData = ^TglBitmapPixelData;
  750. ////////////////////////////////////////////////////////////////////////////////////////////////////
  751. TglBitmapPixelPositionFields = set of (ffX, ffY);
  752. TglBitmapPixelPosition = record
  753. Fields : TglBitmapPixelPositionFields;
  754. X : Word;
  755. Y : Word;
  756. end;
  757. TglBitmapFormatDescriptor = class(TObject)
  758. protected
  759. function GetIsCompressed: Boolean; virtual; abstract;
  760. function GetHasAlpha: Boolean; virtual; abstract;
  761. function GetglDataFormat: GLenum; virtual; abstract;
  762. function GetglFormat: GLenum; virtual; abstract;
  763. function GetglInternalFormat: GLenum; virtual; abstract;
  764. public
  765. property IsCompressed: Boolean read GetIsCompressed;
  766. property HasAlpha: Boolean read GetHasAlpha;
  767. property glFormat: GLenum read GetglFormat;
  768. property glInternalFormat: GLenum read GetglInternalFormat;
  769. property glDataFormat: GLenum read GetglDataFormat;
  770. end;
  771. ////////////////////////////////////////////////////////////////////////////////////////////////////
  772. TglBitmap = class;
  773. TglBitmapFunctionRec = record
  774. Sender: TglBitmap;
  775. Size: TglBitmapPixelPosition;
  776. Position: TglBitmapPixelPosition;
  777. Source: TglBitmapPixelData;
  778. Dest: TglBitmapPixelData;
  779. Args: Pointer;
  780. end;
  781. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  782. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  783. TglBitmap = class
  784. private
  785. function GetFormatDesc: TglBitmapFormatDescriptor;
  786. protected
  787. fID: GLuint;
  788. fTarget: GLuint;
  789. fAnisotropic: Integer;
  790. fDeleteTextureOnFree: Boolean;
  791. fFreeDataAfterGenTexture: Boolean;
  792. fData: PByte;
  793. fIsResident: Boolean;
  794. fBorderColor: array[0..3] of Single;
  795. fDimension: TglBitmapPixelPosition;
  796. fMipMap: TglBitmapMipMap;
  797. fFormat: TglBitmapFormat;
  798. // Mapping
  799. fPixelSize: Integer;
  800. fRowSize: Integer;
  801. // Filtering
  802. fFilterMin: GLenum;
  803. fFilterMag: GLenum;
  804. // TexturWarp
  805. fWrapS: GLenum;
  806. fWrapT: GLenum;
  807. fWrapR: GLenum;
  808. //Swizzle
  809. fSwizzle: array[0..3] of GLenum;
  810. // CustomData
  811. fFilename: String;
  812. fCustomName: String;
  813. fCustomNameW: WideString;
  814. fCustomData: Pointer;
  815. //Getter
  816. function GetWidth: Integer; virtual;
  817. function GetHeight: Integer; virtual;
  818. function GetFileWidth: Integer; virtual;
  819. function GetFileHeight: Integer; virtual;
  820. //Setter
  821. procedure SetCustomData(const aValue: Pointer);
  822. procedure SetCustomName(const aValue: String);
  823. procedure SetCustomNameW(const aValue: WideString);
  824. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  825. procedure SetFormat(const aValue: TglBitmapFormat);
  826. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  827. procedure SetID(const aValue: Cardinal);
  828. procedure SetMipMap(const aValue: TglBitmapMipMap);
  829. procedure SetTarget(const aValue: Cardinal);
  830. procedure SetAnisotropic(const aValue: Integer);
  831. procedure CreateID;
  832. procedure SetupParameters(out aBuildWithGlu: Boolean);
  833. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  834. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method
  835. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  836. function FlipHorz: Boolean; virtual;
  837. function FlipVert: Boolean; virtual;
  838. property Width: Integer read GetWidth;
  839. property Height: Integer read GetHeight;
  840. property FileWidth: Integer read GetFileWidth;
  841. property FileHeight: Integer read GetFileHeight;
  842. public
  843. //Properties
  844. property ID: Cardinal read fID write SetID;
  845. property Target: Cardinal read fTarget write SetTarget;
  846. property Format: TglBitmapFormat read fFormat write SetFormat;
  847. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  848. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  849. property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc;
  850. property Filename: String read fFilename;
  851. property CustomName: String read fCustomName write SetCustomName;
  852. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  853. property CustomData: Pointer read fCustomData write SetCustomData;
  854. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  855. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  856. property Dimension: TglBitmapPixelPosition read fDimension;
  857. property Data: PByte read fData;
  858. property IsResident: Boolean read fIsResident;
  859. procedure AfterConstruction; override;
  860. procedure BeforeDestruction; override;
  861. procedure PrepareResType(var aResource: String; var aResType: PChar);
  862. //Load
  863. procedure LoadFromFile(const aFilename: String);
  864. procedure LoadFromStream(const aStream: TStream); virtual;
  865. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  866. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  867. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  868. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  869. //Save
  870. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  871. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  872. //Convert
  873. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  874. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  875. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  876. public
  877. //Alpha & Co
  878. {$IFDEF GLB_SDL}
  879. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  880. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  881. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  882. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  883. const aArgs: Pointer = nil): Boolean;
  884. {$ENDIF}
  885. {$IFDEF GLB_DELPHI}
  886. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  887. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  888. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  889. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  890. const aArgs: Pointer = nil): Boolean;
  891. {$ENDIF}
  892. {$IFDEF GLB_LAZARUS}
  893. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  894. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  895. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  896. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  897. const aArgs: Pointer = nil): Boolean;
  898. {$ENDIF}
  899. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  900. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  901. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  902. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  903. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  904. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  905. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  906. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  907. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  908. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  909. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  910. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  911. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  912. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  913. function RemoveAlpha: Boolean; virtual;
  914. public
  915. //Common
  916. function Clone: TglBitmap;
  917. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  918. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  919. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  920. procedure FreeData;
  921. //ColorFill
  922. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  923. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  924. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  925. //TexParameters
  926. procedure SetFilter(const aMin, aMag: GLenum);
  927. procedure SetWrap(
  928. const S: GLenum = GL_CLAMP_TO_EDGE;
  929. const T: GLenum = GL_CLAMP_TO_EDGE;
  930. const R: GLenum = GL_CLAMP_TO_EDGE);
  931. procedure SetSwizzle(const r, g, b, a: GLenum);
  932. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  933. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  934. //Constructors
  935. constructor Create; overload;
  936. constructor Create(const aFileName: String); overload;
  937. constructor Create(const aStream: TStream); overload;
  938. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
  939. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  940. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  941. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  942. private
  943. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  944. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  945. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  946. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  947. function LoadBMP(const aStream: TStream): Boolean; virtual;
  948. procedure SaveBMP(const aStream: TStream); virtual;
  949. function LoadTGA(const aStream: TStream): Boolean; virtual;
  950. procedure SaveTGA(const aStream: TStream); virtual;
  951. function LoadDDS(const aStream: TStream): Boolean; virtual;
  952. procedure SaveDDS(const aStream: TStream); virtual;
  953. end;
  954. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  955. TglBitmap1D = class(TglBitmap)
  956. protected
  957. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  958. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  959. procedure UploadData(const aBuildWithGlu: Boolean);
  960. public
  961. property Width;
  962. procedure AfterConstruction; override;
  963. function FlipHorz: Boolean; override;
  964. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  965. end;
  966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  967. TglBitmap2D = class(TglBitmap)
  968. protected
  969. fLines: array of PByte;
  970. function GetScanline(const aIndex: Integer): Pointer;
  971. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  972. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  973. procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  974. public
  975. property Width;
  976. property Height;
  977. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  978. procedure AfterConstruction; override;
  979. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  980. procedure GetDataFromTexture;
  981. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  982. function FlipHorz: Boolean; override;
  983. function FlipVert: Boolean; override;
  984. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  985. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  986. end;
  987. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  988. TglBitmapCubeMap = class(TglBitmap2D)
  989. protected
  990. fGenMode: Integer;
  991. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  992. public
  993. procedure AfterConstruction; override;
  994. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  995. procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  996. procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  997. end;
  998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  999. TglBitmapNormalMap = class(TglBitmapCubeMap)
  1000. public
  1001. procedure AfterConstruction; override;
  1002. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  1003. end;
  1004. const
  1005. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1006. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1007. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1008. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1009. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1010. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1011. procedure glBitmapSetDefaultWrap(
  1012. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1013. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1014. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1015. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1016. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1017. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1018. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1019. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1020. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1021. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1022. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1023. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1024. var
  1025. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1026. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1027. glBitmapDefaultFormat: TglBitmapFormat;
  1028. glBitmapDefaultMipmap: TglBitmapMipMap;
  1029. glBitmapDefaultFilterMin: Cardinal;
  1030. glBitmapDefaultFilterMag: Cardinal;
  1031. glBitmapDefaultWrapS: Cardinal;
  1032. glBitmapDefaultWrapT: Cardinal;
  1033. glBitmapDefaultWrapR: Cardinal;
  1034. glDefaultSwizzle: array[0..3] of GLenum;
  1035. {$IFDEF GLB_DELPHI}
  1036. function CreateGrayPalette: HPALETTE;
  1037. {$ENDIF}
  1038. implementation
  1039. uses
  1040. Math, syncobjs, typinfo
  1041. {$IFDEF GLB_DELPHI}, Types{$ENDIF};
  1042. type
  1043. {$IFNDEF fpc}
  1044. QWord = System.UInt64;
  1045. PQWord = ^QWord;
  1046. PtrInt = Longint;
  1047. PtrUInt = DWord;
  1048. {$ENDIF}
  1049. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1050. TShiftRec = packed record
  1051. case Integer of
  1052. 0: (r, g, b, a: Byte);
  1053. 1: (arr: array[0..3] of Byte);
  1054. end;
  1055. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1056. private
  1057. function GetRedMask: QWord;
  1058. function GetGreenMask: QWord;
  1059. function GetBlueMask: QWord;
  1060. function GetAlphaMask: QWord;
  1061. protected
  1062. fFormat: TglBitmapFormat;
  1063. fWithAlpha: TglBitmapFormat;
  1064. fWithoutAlpha: TglBitmapFormat;
  1065. fRGBInverted: TglBitmapFormat;
  1066. fUncompressed: TglBitmapFormat;
  1067. fPixelSize: Single;
  1068. fIsCompressed: Boolean;
  1069. fRange: TglBitmapColorRec;
  1070. fShift: TShiftRec;
  1071. fglFormat: GLenum;
  1072. fglInternalFormat: GLenum;
  1073. fglDataFormat: GLenum;
  1074. function GetIsCompressed: Boolean; override;
  1075. function GetHasAlpha: Boolean; override;
  1076. function GetglFormat: GLenum; override;
  1077. function GetglInternalFormat: GLenum; override;
  1078. function GetglDataFormat: GLenum; override;
  1079. function GetComponents: Integer; virtual;
  1080. public
  1081. property Format: TglBitmapFormat read fFormat;
  1082. property WithAlpha: TglBitmapFormat read fWithAlpha;
  1083. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  1084. property RGBInverted: TglBitmapFormat read fRGBInverted;
  1085. property Components: Integer read GetComponents;
  1086. property PixelSize: Single read fPixelSize;
  1087. property Range: TglBitmapColorRec read fRange;
  1088. property Shift: TShiftRec read fShift;
  1089. property RedMask: QWord read GetRedMask;
  1090. property GreenMask: QWord read GetGreenMask;
  1091. property BlueMask: QWord read GetBlueMask;
  1092. property AlphaMask: QWord read GetAlphaMask;
  1093. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1094. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1095. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1096. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1097. function CreateMappingData: Pointer; virtual;
  1098. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1099. function IsEmpty: Boolean; virtual;
  1100. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  1101. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1102. constructor Create; virtual;
  1103. public
  1104. class procedure Init;
  1105. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1106. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1107. class procedure Clear;
  1108. class procedure Finalize;
  1109. end;
  1110. TFormatDescriptorClass = class of TFormatDescriptor;
  1111. TfdEmpty = class(TFormatDescriptor);
  1112. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1113. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1114. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1115. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1116. constructor Create; override;
  1117. end;
  1118. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1119. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1120. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1121. constructor Create; override;
  1122. end;
  1123. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1124. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1125. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1126. constructor Create; override;
  1127. end;
  1128. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1129. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1130. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1131. constructor Create; override;
  1132. end;
  1133. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1134. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1135. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1136. constructor Create; override;
  1137. end;
  1138. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1139. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1140. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1141. constructor Create; override;
  1142. end;
  1143. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1144. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1145. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1146. constructor Create; override;
  1147. end;
  1148. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1149. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1150. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1151. constructor Create; override;
  1152. end;
  1153. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1154. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  1155. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1156. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1157. constructor Create; override;
  1158. end;
  1159. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  1160. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1161. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1162. constructor Create; override;
  1163. end;
  1164. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1165. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1166. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1167. constructor Create; override;
  1168. end;
  1169. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1170. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1171. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1172. constructor Create; override;
  1173. end;
  1174. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1175. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1176. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1177. constructor Create; override;
  1178. end;
  1179. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1180. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1181. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1182. constructor Create; override;
  1183. end;
  1184. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1185. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1186. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1187. constructor Create; override;
  1188. end;
  1189. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1190. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1191. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1192. constructor Create; override;
  1193. end;
  1194. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1195. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1196. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1197. constructor Create; override;
  1198. end;
  1199. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1200. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  1201. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1202. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1203. constructor Create; override;
  1204. end;
  1205. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1206. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1207. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1208. constructor Create; override;
  1209. end;
  1210. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1211. TfdAlpha4 = class(TfdAlpha_UB1)
  1212. constructor Create; override;
  1213. end;
  1214. TfdAlpha8 = class(TfdAlpha_UB1)
  1215. constructor Create; override;
  1216. end;
  1217. TfdAlpha12 = class(TfdAlpha_US1)
  1218. constructor Create; override;
  1219. end;
  1220. TfdAlpha16 = class(TfdAlpha_US1)
  1221. constructor Create; override;
  1222. end;
  1223. TfdLuminance4 = class(TfdLuminance_UB1)
  1224. constructor Create; override;
  1225. end;
  1226. TfdLuminance8 = class(TfdLuminance_UB1)
  1227. constructor Create; override;
  1228. end;
  1229. TfdLuminance12 = class(TfdLuminance_US1)
  1230. constructor Create; override;
  1231. end;
  1232. TfdLuminance16 = class(TfdLuminance_US1)
  1233. constructor Create; override;
  1234. end;
  1235. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1236. constructor Create; override;
  1237. end;
  1238. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1239. constructor Create; override;
  1240. end;
  1241. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1242. constructor Create; override;
  1243. end;
  1244. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1245. constructor Create; override;
  1246. end;
  1247. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1248. constructor Create; override;
  1249. end;
  1250. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1251. constructor Create; override;
  1252. end;
  1253. TfdR3G3B2 = class(TfdUniversal_UB1)
  1254. constructor Create; override;
  1255. end;
  1256. TfdRGB4 = class(TfdUniversal_US1)
  1257. constructor Create; override;
  1258. end;
  1259. TfdR5G6B5 = class(TfdUniversal_US1)
  1260. constructor Create; override;
  1261. end;
  1262. TfdRGB5 = class(TfdUniversal_US1)
  1263. constructor Create; override;
  1264. end;
  1265. TfdRGB8 = class(TfdRGB_UB3)
  1266. constructor Create; override;
  1267. end;
  1268. TfdRGB10 = class(TfdUniversal_UI1)
  1269. constructor Create; override;
  1270. end;
  1271. TfdRGB12 = class(TfdRGB_US3)
  1272. constructor Create; override;
  1273. end;
  1274. TfdRGB16 = class(TfdRGB_US3)
  1275. constructor Create; override;
  1276. end;
  1277. TfdRGBA2 = class(TfdRGBA_UB4)
  1278. constructor Create; override;
  1279. end;
  1280. TfdRGBA4 = class(TfdUniversal_US1)
  1281. constructor Create; override;
  1282. end;
  1283. TfdRGB5A1 = class(TfdUniversal_US1)
  1284. constructor Create; override;
  1285. end;
  1286. TfdRGBA8 = class(TfdRGBA_UB4)
  1287. constructor Create; override;
  1288. end;
  1289. TfdRGB10A2 = class(TfdUniversal_UI1)
  1290. constructor Create; override;
  1291. end;
  1292. TfdRGBA12 = class(TfdRGBA_US4)
  1293. constructor Create; override;
  1294. end;
  1295. TfdRGBA16 = class(TfdRGBA_US4)
  1296. constructor Create; override;
  1297. end;
  1298. TfdBGR4 = class(TfdUniversal_US1)
  1299. constructor Create; override;
  1300. end;
  1301. TfdB5G6R5 = class(TfdUniversal_US1)
  1302. constructor Create; override;
  1303. end;
  1304. TfdBGR5 = class(TfdUniversal_US1)
  1305. constructor Create; override;
  1306. end;
  1307. TfdBGR8 = class(TfdBGR_UB3)
  1308. constructor Create; override;
  1309. end;
  1310. TfdBGR10 = class(TfdUniversal_UI1)
  1311. constructor Create; override;
  1312. end;
  1313. TfdBGR12 = class(TfdBGR_US3)
  1314. constructor Create; override;
  1315. end;
  1316. TfdBGR16 = class(TfdBGR_US3)
  1317. constructor Create; override;
  1318. end;
  1319. TfdBGRA2 = class(TfdBGRA_UB4)
  1320. constructor Create; override;
  1321. end;
  1322. TfdBGRA4 = class(TfdUniversal_US1)
  1323. constructor Create; override;
  1324. end;
  1325. TfdBGR5A1 = class(TfdUniversal_US1)
  1326. constructor Create; override;
  1327. end;
  1328. TfdBGRA8 = class(TfdBGRA_UB4)
  1329. constructor Create; override;
  1330. end;
  1331. TfdBGR10A2 = class(TfdUniversal_UI1)
  1332. constructor Create; override;
  1333. end;
  1334. TfdBGRA12 = class(TfdBGRA_US4)
  1335. constructor Create; override;
  1336. end;
  1337. TfdBGRA16 = class(TfdBGRA_US4)
  1338. constructor Create; override;
  1339. end;
  1340. TfdDepth16 = class(TfdDepth_US1)
  1341. constructor Create; override;
  1342. end;
  1343. TfdDepth24 = class(TfdDepth_UI1)
  1344. constructor Create; override;
  1345. end;
  1346. TfdDepth32 = class(TfdDepth_UI1)
  1347. constructor Create; override;
  1348. end;
  1349. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1350. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1351. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1352. constructor Create; override;
  1353. end;
  1354. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1355. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1356. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1357. constructor Create; override;
  1358. end;
  1359. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1360. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1361. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1362. constructor Create; override;
  1363. end;
  1364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1365. TbmpBitfieldFormat = class(TFormatDescriptor)
  1366. private
  1367. procedure SetRedMask (const aValue: QWord);
  1368. procedure SetGreenMask(const aValue: QWord);
  1369. procedure SetBlueMask (const aValue: QWord);
  1370. procedure SetAlphaMask(const aValue: QWord);
  1371. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1372. public
  1373. property RedMask: QWord read GetRedMask write SetRedMask;
  1374. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1375. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1376. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1377. property PixelSize: Single read fPixelSize write fPixelSize;
  1378. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1379. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1380. end;
  1381. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1382. TbmpColorTableEnty = packed record
  1383. b, g, r, a: Byte;
  1384. end;
  1385. TbmpColorTable = array of TbmpColorTableEnty;
  1386. TbmpColorTableFormat = class(TFormatDescriptor)
  1387. private
  1388. fColorTable: TbmpColorTable;
  1389. public
  1390. property PixelSize: Single read fPixelSize write fPixelSize;
  1391. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1392. property Range: TglBitmapColorRec read fRange write fRange;
  1393. property Shift: TShiftRec read fShift write fShift;
  1394. property Format: TglBitmapFormat read fFormat write fFormat;
  1395. procedure CreateColorTable;
  1396. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1397. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1398. destructor Destroy; override;
  1399. end;
  1400. const
  1401. LUMINANCE_WEIGHT_R = 0.30;
  1402. LUMINANCE_WEIGHT_G = 0.59;
  1403. LUMINANCE_WEIGHT_B = 0.11;
  1404. ALPHA_WEIGHT_R = 0.30;
  1405. ALPHA_WEIGHT_G = 0.59;
  1406. ALPHA_WEIGHT_B = 0.11;
  1407. DEPTH_WEIGHT_R = 0.333333333;
  1408. DEPTH_WEIGHT_G = 0.333333333;
  1409. DEPTH_WEIGHT_B = 0.333333333;
  1410. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1411. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1412. TfdEmpty,
  1413. TfdAlpha4,
  1414. TfdAlpha8,
  1415. TfdAlpha12,
  1416. TfdAlpha16,
  1417. TfdLuminance4,
  1418. TfdLuminance8,
  1419. TfdLuminance12,
  1420. TfdLuminance16,
  1421. TfdLuminance4Alpha4,
  1422. TfdLuminance6Alpha2,
  1423. TfdLuminance8Alpha8,
  1424. TfdLuminance12Alpha4,
  1425. TfdLuminance12Alpha12,
  1426. TfdLuminance16Alpha16,
  1427. TfdR3G3B2,
  1428. TfdRGB4,
  1429. TfdR5G6B5,
  1430. TfdRGB5,
  1431. TfdRGB8,
  1432. TfdRGB10,
  1433. TfdRGB12,
  1434. TfdRGB16,
  1435. TfdRGBA2,
  1436. TfdRGBA4,
  1437. TfdRGB5A1,
  1438. TfdRGBA8,
  1439. TfdRGB10A2,
  1440. TfdRGBA12,
  1441. TfdRGBA16,
  1442. TfdBGR4,
  1443. TfdB5G6R5,
  1444. TfdBGR5,
  1445. TfdBGR8,
  1446. TfdBGR10,
  1447. TfdBGR12,
  1448. TfdBGR16,
  1449. TfdBGRA2,
  1450. TfdBGRA4,
  1451. TfdBGR5A1,
  1452. TfdBGRA8,
  1453. TfdBGR10A2,
  1454. TfdBGRA12,
  1455. TfdBGRA16,
  1456. TfdDepth16,
  1457. TfdDepth24,
  1458. TfdDepth32,
  1459. TfdS3tcDtx1RGBA,
  1460. TfdS3tcDtx3RGBA,
  1461. TfdS3tcDtx5RGBA
  1462. );
  1463. var
  1464. FormatDescriptorCS: TCriticalSection;
  1465. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1466. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1467. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1468. begin
  1469. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1470. end;
  1471. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1472. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1473. begin
  1474. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1475. end;
  1476. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1477. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1478. begin
  1479. result.Fields := [];
  1480. if X >= 0 then
  1481. result.Fields := result.Fields + [ffX];
  1482. if Y >= 0 then
  1483. result.Fields := result.Fields + [ffY];
  1484. result.X := Max(0, X);
  1485. result.Y := Max(0, Y);
  1486. end;
  1487. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1488. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1489. begin
  1490. result.r := r;
  1491. result.g := g;
  1492. result.b := b;
  1493. result.a := a;
  1494. end;
  1495. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1496. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1497. var
  1498. i: Integer;
  1499. begin
  1500. result := false;
  1501. for i := 0 to high(r1.arr) do
  1502. if (r1.arr[i] <> r2.arr[i]) then
  1503. exit;
  1504. result := true;
  1505. end;
  1506. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1507. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1508. begin
  1509. result.r := r;
  1510. result.g := g;
  1511. result.b := b;
  1512. result.a := a;
  1513. end;
  1514. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1515. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1516. begin
  1517. result := [];
  1518. if (aFormat in [
  1519. //4 bbp
  1520. tfLuminance4,
  1521. //8bpp
  1522. tfR3G3B2, tfLuminance8,
  1523. //16bpp
  1524. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1525. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1526. //24bpp
  1527. tfBGR8, tfRGB8,
  1528. //32bpp
  1529. tfRGB10, tfRGB10A2, tfRGBA8,
  1530. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1531. result := result + [ftBMP];
  1532. if (aFormat in [
  1533. //8 bpp
  1534. tfLuminance8, tfAlpha8,
  1535. //16 bpp
  1536. tfLuminance16, tfLuminance8Alpha8,
  1537. tfRGB5, tfRGB5A1, tfRGBA4,
  1538. tfBGR5, tfBGR5A1, tfBGRA4,
  1539. //24 bpp
  1540. tfRGB8, tfBGR8,
  1541. //32 bpp
  1542. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1543. result := result + [ftTGA];
  1544. if (aFormat in [
  1545. //8 bpp
  1546. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1547. tfR3G3B2, tfRGBA2, tfBGRA2,
  1548. //16 bpp
  1549. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1550. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1551. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1552. //24 bpp
  1553. tfRGB8, tfBGR8,
  1554. //32 bbp
  1555. tfLuminance16Alpha16,
  1556. tfRGBA8, tfRGB10A2,
  1557. tfBGRA8, tfBGR10A2,
  1558. //compressed
  1559. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1560. result := result + [ftDDS];
  1561. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1562. if aFormat in [
  1563. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1564. tfRGB8, tfRGBA8,
  1565. tfBGR8, tfBGRA8] then
  1566. result := result + [ftPNG];
  1567. {$ENDIF}
  1568. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1569. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1570. result := result + [ftJPEG];
  1571. {$ENDIF}
  1572. end;
  1573. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1574. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1575. begin
  1576. while (aNumber and 1) = 0 do
  1577. aNumber := aNumber shr 1;
  1578. result := aNumber = 1;
  1579. end;
  1580. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1581. function GetTopMostBit(aBitSet: QWord): Integer;
  1582. begin
  1583. result := 0;
  1584. while aBitSet > 0 do begin
  1585. inc(result);
  1586. aBitSet := aBitSet shr 1;
  1587. end;
  1588. end;
  1589. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1590. function CountSetBits(aBitSet: QWord): Integer;
  1591. begin
  1592. result := 0;
  1593. while aBitSet > 0 do begin
  1594. if (aBitSet and 1) = 1 then
  1595. inc(result);
  1596. aBitSet := aBitSet shr 1;
  1597. end;
  1598. end;
  1599. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1600. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1601. begin
  1602. result := Trunc(
  1603. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1604. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1605. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1606. end;
  1607. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1608. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1609. begin
  1610. result := Trunc(
  1611. DEPTH_WEIGHT_R * aPixel.Data.r +
  1612. DEPTH_WEIGHT_G * aPixel.Data.g +
  1613. DEPTH_WEIGHT_B * aPixel.Data.b);
  1614. end;
  1615. {$IFDEF GLB_NATIVE_OGL}
  1616. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1617. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1618. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1619. var
  1620. GL_LibHandle: Pointer = nil;
  1621. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
  1622. begin
  1623. if not Assigned(aLibHandle) then
  1624. aLibHandle := GL_LibHandle;
  1625. {$IF DEFINED(GLB_WIN)}
  1626. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1627. if Assigned(result) then
  1628. exit;
  1629. if Assigned(wglGetProcAddress) then
  1630. result := wglGetProcAddress(aProcName);
  1631. {$ELSEIF DEFINED(GLB_LINUX)}
  1632. if Assigned(glXGetProcAddress) then begin
  1633. result := glXGetProcAddress(aProcName);
  1634. if Assigned(result) then
  1635. exit;
  1636. end;
  1637. if Assigned(glXGetProcAddressARB) then begin
  1638. result := glXGetProcAddressARB(aProcName);
  1639. if Assigned(result) then
  1640. exit;
  1641. end;
  1642. result := dlsym(aLibHandle, aProcName);
  1643. {$IFEND}
  1644. if not Assigned(result) and aRaiseOnErr then
  1645. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1646. end;
  1647. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1648. var
  1649. GLU_LibHandle: Pointer = nil;
  1650. OpenGLInitialized: Boolean;
  1651. InitOpenGLCS: TCriticalSection;
  1652. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1653. procedure glbInitOpenGL;
  1654. ////////////////////////////////////////////////////////////////////////////////
  1655. function glbLoadLibrary(const aName: PChar): Pointer;
  1656. begin
  1657. {$IF DEFINED(GLB_WIN)}
  1658. result := {%H-}Pointer(LoadLibrary(aName));
  1659. {$ELSEIF DEFINED(GLB_LINUX)}
  1660. result := dlopen(Name, RTLD_LAZY);
  1661. {$ELSE}
  1662. result := nil;
  1663. {$IFEND}
  1664. end;
  1665. ////////////////////////////////////////////////////////////////////////////////
  1666. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1667. begin
  1668. result := false;
  1669. if not Assigned(aLibHandle) then
  1670. exit;
  1671. {$IF DEFINED(GLB_WIN)}
  1672. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1673. {$ELSEIF DEFINED(GLB_LINUX)}
  1674. Result := dlclose(aLibHandle) = 0;
  1675. {$IFEND}
  1676. end;
  1677. begin
  1678. if Assigned(GL_LibHandle) then
  1679. glbFreeLibrary(GL_LibHandle);
  1680. if Assigned(GLU_LibHandle) then
  1681. glbFreeLibrary(GLU_LibHandle);
  1682. GL_LibHandle := glbLoadLibrary(libopengl);
  1683. if not Assigned(GL_LibHandle) then
  1684. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1685. GLU_LibHandle := glbLoadLibrary(libglu);
  1686. if not Assigned(GLU_LibHandle) then
  1687. raise EglBitmap.Create('unable to load library: ' + libglu);
  1688. {$IF DEFINED(GLB_WIN)}
  1689. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1690. {$ELSEIF DEFINED(GLB_LINUX)}
  1691. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1692. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1693. {$IFEND}
  1694. glEnable := glbGetProcAddress('glEnable');
  1695. glDisable := glbGetProcAddress('glDisable');
  1696. glGetString := glbGetProcAddress('glGetString');
  1697. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1698. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1699. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1700. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1701. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1702. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1703. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1704. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1705. glTexGeni := glbGetProcAddress('glTexGeni');
  1706. glGenTextures := glbGetProcAddress('glGenTextures');
  1707. glBindTexture := glbGetProcAddress('glBindTexture');
  1708. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1709. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1710. glReadPixels := glbGetProcAddress('glReadPixels');
  1711. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1712. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1713. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1714. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1715. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1716. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1717. end;
  1718. {$ENDIF}
  1719. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1720. procedure glbReadOpenGLExtensions;
  1721. var
  1722. Buffer: AnsiString;
  1723. MajorVersion, MinorVersion: Integer;
  1724. ///////////////////////////////////////////////////////////////////////////////////////////
  1725. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1726. var
  1727. Separator: Integer;
  1728. begin
  1729. aMinor := 0;
  1730. aMajor := 0;
  1731. Separator := Pos(AnsiString('.'), aBuffer);
  1732. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1733. (aBuffer[Separator - 1] in ['0'..'9']) and
  1734. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1735. Dec(Separator);
  1736. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1737. Dec(Separator);
  1738. Delete(aBuffer, 1, Separator);
  1739. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1740. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1741. Inc(Separator);
  1742. Delete(aBuffer, Separator, 255);
  1743. Separator := Pos(AnsiString('.'), aBuffer);
  1744. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1745. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1746. end;
  1747. end;
  1748. ///////////////////////////////////////////////////////////////////////////////////////////
  1749. function CheckExtension(const Extension: AnsiString): Boolean;
  1750. var
  1751. ExtPos: Integer;
  1752. begin
  1753. ExtPos := Pos(Extension, Buffer);
  1754. result := ExtPos > 0;
  1755. if result then
  1756. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1757. end;
  1758. ///////////////////////////////////////////////////////////////////////////////////////////
  1759. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1760. begin
  1761. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1762. end;
  1763. begin
  1764. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1765. InitOpenGLCS.Enter;
  1766. try
  1767. if not OpenGLInitialized then begin
  1768. glbInitOpenGL;
  1769. OpenGLInitialized := true;
  1770. end;
  1771. finally
  1772. InitOpenGLCS.Leave;
  1773. end;
  1774. {$ENDIF}
  1775. // Version
  1776. Buffer := glGetString(GL_VERSION);
  1777. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1778. GL_VERSION_1_2 := CheckVersion(1, 2);
  1779. GL_VERSION_1_3 := CheckVersion(1, 3);
  1780. GL_VERSION_1_4 := CheckVersion(1, 4);
  1781. GL_VERSION_2_0 := CheckVersion(2, 0);
  1782. GL_VERSION_3_3 := CheckVersion(3, 3);
  1783. // Extensions
  1784. Buffer := glGetString(GL_EXTENSIONS);
  1785. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1786. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1787. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1788. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1789. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1790. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1791. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1792. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1793. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1794. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1795. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1796. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1797. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1798. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1799. if GL_VERSION_1_3 then begin
  1800. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1801. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1802. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1803. end else begin
  1804. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false);
  1805. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false);
  1806. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
  1807. end;
  1808. end;
  1809. {$ENDIF}
  1810. {$IFDEF GLB_SDL_IMAGE}
  1811. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1812. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1813. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1814. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1815. begin
  1816. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1817. end;
  1818. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1819. begin
  1820. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1821. end;
  1822. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1823. begin
  1824. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1825. end;
  1826. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1827. begin
  1828. result := 0;
  1829. end;
  1830. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1831. begin
  1832. result := SDL_AllocRW;
  1833. if result = nil then
  1834. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1835. result^.seek := glBitmapRWseek;
  1836. result^.read := glBitmapRWread;
  1837. result^.write := glBitmapRWwrite;
  1838. result^.close := glBitmapRWclose;
  1839. result^.unknown.data1 := Stream;
  1840. end;
  1841. {$ENDIF}
  1842. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1843. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1844. begin
  1845. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1846. end;
  1847. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1848. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1849. begin
  1850. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1851. end;
  1852. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1853. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1854. begin
  1855. glBitmapDefaultMipmap := aValue;
  1856. end;
  1857. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1858. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1859. begin
  1860. glBitmapDefaultFormat := aFormat;
  1861. end;
  1862. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1863. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1864. begin
  1865. glBitmapDefaultFilterMin := aMin;
  1866. glBitmapDefaultFilterMag := aMag;
  1867. end;
  1868. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1869. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1870. begin
  1871. glBitmapDefaultWrapS := S;
  1872. glBitmapDefaultWrapT := T;
  1873. glBitmapDefaultWrapR := R;
  1874. end;
  1875. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1876. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1877. begin
  1878. glDefaultSwizzle[0] := r;
  1879. glDefaultSwizzle[1] := g;
  1880. glDefaultSwizzle[2] := b;
  1881. glDefaultSwizzle[3] := a;
  1882. end;
  1883. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1884. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1885. begin
  1886. result := glBitmapDefaultDeleteTextureOnFree;
  1887. end;
  1888. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1889. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1890. begin
  1891. result := glBitmapDefaultFreeDataAfterGenTextures;
  1892. end;
  1893. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1894. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1895. begin
  1896. result := glBitmapDefaultMipmap;
  1897. end;
  1898. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1899. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1900. begin
  1901. result := glBitmapDefaultFormat;
  1902. end;
  1903. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1904. procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
  1905. begin
  1906. aMin := glBitmapDefaultFilterMin;
  1907. aMag := glBitmapDefaultFilterMag;
  1908. end;
  1909. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1910. procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
  1911. begin
  1912. S := glBitmapDefaultWrapS;
  1913. T := glBitmapDefaultWrapT;
  1914. R := glBitmapDefaultWrapR;
  1915. end;
  1916. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1917. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1918. begin
  1919. r := glDefaultSwizzle[0];
  1920. g := glDefaultSwizzle[1];
  1921. b := glDefaultSwizzle[2];
  1922. a := glDefaultSwizzle[3];
  1923. end;
  1924. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1925. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1926. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1927. function TFormatDescriptor.GetRedMask: QWord;
  1928. begin
  1929. result := fRange.r shl fShift.r;
  1930. end;
  1931. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1932. function TFormatDescriptor.GetGreenMask: QWord;
  1933. begin
  1934. result := fRange.g shl fShift.g;
  1935. end;
  1936. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1937. function TFormatDescriptor.GetBlueMask: QWord;
  1938. begin
  1939. result := fRange.b shl fShift.b;
  1940. end;
  1941. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1942. function TFormatDescriptor.GetAlphaMask: QWord;
  1943. begin
  1944. result := fRange.a shl fShift.a;
  1945. end;
  1946. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1947. function TFormatDescriptor.GetIsCompressed: Boolean;
  1948. begin
  1949. result := fIsCompressed;
  1950. end;
  1951. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1952. function TFormatDescriptor.GetHasAlpha: Boolean;
  1953. begin
  1954. result := (fRange.a > 0);
  1955. end;
  1956. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1957. function TFormatDescriptor.GetglFormat: GLenum;
  1958. begin
  1959. result := fglFormat;
  1960. end;
  1961. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1962. function TFormatDescriptor.GetglInternalFormat: GLenum;
  1963. begin
  1964. result := fglInternalFormat;
  1965. end;
  1966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1967. function TFormatDescriptor.GetglDataFormat: GLenum;
  1968. begin
  1969. result := fglDataFormat;
  1970. end;
  1971. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1972. function TFormatDescriptor.GetComponents: Integer;
  1973. var
  1974. i: Integer;
  1975. begin
  1976. result := 0;
  1977. for i := 0 to 3 do
  1978. if (fRange.arr[i] > 0) then
  1979. inc(result);
  1980. end;
  1981. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1982. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  1983. var
  1984. w, h: Integer;
  1985. begin
  1986. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  1987. w := Max(1, aSize.X);
  1988. h := Max(1, aSize.Y);
  1989. result := GetSize(w, h);
  1990. end else
  1991. result := 0;
  1992. end;
  1993. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1994. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  1995. begin
  1996. result := 0;
  1997. if (aWidth <= 0) or (aHeight <= 0) then
  1998. exit;
  1999. result := Ceil(aWidth * aHeight * fPixelSize);
  2000. end;
  2001. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2002. function TFormatDescriptor.CreateMappingData: Pointer;
  2003. begin
  2004. result := nil;
  2005. end;
  2006. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2007. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2008. begin
  2009. //DUMMY
  2010. end;
  2011. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2012. function TFormatDescriptor.IsEmpty: Boolean;
  2013. begin
  2014. result := (fFormat = tfEmpty);
  2015. end;
  2016. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2017. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  2018. begin
  2019. result := false;
  2020. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2021. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2022. if (aRedMask <> RedMask) then
  2023. exit;
  2024. if (aGreenMask <> GreenMask) then
  2025. exit;
  2026. if (aBlueMask <> BlueMask) then
  2027. exit;
  2028. if (aAlphaMask <> AlphaMask) then
  2029. exit;
  2030. result := true;
  2031. end;
  2032. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2033. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2034. begin
  2035. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2036. aPixel.Data := fRange;
  2037. aPixel.Range := fRange;
  2038. aPixel.Format := fFormat;
  2039. end;
  2040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2041. constructor TFormatDescriptor.Create;
  2042. begin
  2043. inherited Create;
  2044. fFormat := tfEmpty;
  2045. fWithAlpha := tfEmpty;
  2046. fWithoutAlpha := tfEmpty;
  2047. fRGBInverted := tfEmpty;
  2048. fUncompressed := tfEmpty;
  2049. fPixelSize := 0.0;
  2050. fIsCompressed := false;
  2051. fglFormat := 0;
  2052. fglInternalFormat := 0;
  2053. fglDataFormat := 0;
  2054. FillChar(fRange, 0, SizeOf(fRange));
  2055. FillChar(fShift, 0, SizeOf(fShift));
  2056. end;
  2057. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2058. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2059. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2060. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2061. begin
  2062. aData^ := aPixel.Data.a;
  2063. inc(aData);
  2064. end;
  2065. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2066. begin
  2067. aPixel.Data.r := 0;
  2068. aPixel.Data.g := 0;
  2069. aPixel.Data.b := 0;
  2070. aPixel.Data.a := aData^;
  2071. inc(aData);
  2072. end;
  2073. constructor TfdAlpha_UB1.Create;
  2074. begin
  2075. inherited Create;
  2076. fPixelSize := 1.0;
  2077. fRange.a := $FF;
  2078. fglFormat := GL_ALPHA;
  2079. fglDataFormat := GL_UNSIGNED_BYTE;
  2080. end;
  2081. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2082. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2083. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2084. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2085. begin
  2086. aData^ := LuminanceWeight(aPixel);
  2087. inc(aData);
  2088. end;
  2089. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2090. begin
  2091. aPixel.Data.r := aData^;
  2092. aPixel.Data.g := aData^;
  2093. aPixel.Data.b := aData^;
  2094. aPixel.Data.a := 0;
  2095. inc(aData);
  2096. end;
  2097. constructor TfdLuminance_UB1.Create;
  2098. begin
  2099. inherited Create;
  2100. fPixelSize := 1.0;
  2101. fRange.r := $FF;
  2102. fRange.g := $FF;
  2103. fRange.b := $FF;
  2104. fglFormat := GL_LUMINANCE;
  2105. fglDataFormat := GL_UNSIGNED_BYTE;
  2106. end;
  2107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2108. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2109. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2110. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2111. var
  2112. i: Integer;
  2113. begin
  2114. aData^ := 0;
  2115. for i := 0 to 3 do
  2116. if (fRange.arr[i] > 0) then
  2117. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2118. inc(aData);
  2119. end;
  2120. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2121. var
  2122. i: Integer;
  2123. begin
  2124. for i := 0 to 3 do
  2125. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2126. inc(aData);
  2127. end;
  2128. constructor TfdUniversal_UB1.Create;
  2129. begin
  2130. inherited Create;
  2131. fPixelSize := 1.0;
  2132. end;
  2133. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2134. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2136. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2137. begin
  2138. inherited Map(aPixel, aData, aMapData);
  2139. aData^ := aPixel.Data.a;
  2140. inc(aData);
  2141. end;
  2142. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2143. begin
  2144. inherited Unmap(aData, aPixel, aMapData);
  2145. aPixel.Data.a := aData^;
  2146. inc(aData);
  2147. end;
  2148. constructor TfdLuminanceAlpha_UB2.Create;
  2149. begin
  2150. inherited Create;
  2151. fPixelSize := 2.0;
  2152. fRange.a := $FF;
  2153. fShift.a := 8;
  2154. fglFormat := GL_LUMINANCE_ALPHA;
  2155. fglDataFormat := GL_UNSIGNED_BYTE;
  2156. end;
  2157. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2158. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2159. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2160. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2161. begin
  2162. aData^ := aPixel.Data.r;
  2163. inc(aData);
  2164. aData^ := aPixel.Data.g;
  2165. inc(aData);
  2166. aData^ := aPixel.Data.b;
  2167. inc(aData);
  2168. end;
  2169. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2170. begin
  2171. aPixel.Data.r := aData^;
  2172. inc(aData);
  2173. aPixel.Data.g := aData^;
  2174. inc(aData);
  2175. aPixel.Data.b := aData^;
  2176. inc(aData);
  2177. aPixel.Data.a := 0;
  2178. end;
  2179. constructor TfdRGB_UB3.Create;
  2180. begin
  2181. inherited Create;
  2182. fPixelSize := 3.0;
  2183. fRange.r := $FF;
  2184. fRange.g := $FF;
  2185. fRange.b := $FF;
  2186. fShift.r := 0;
  2187. fShift.g := 8;
  2188. fShift.b := 16;
  2189. fglFormat := GL_RGB;
  2190. fglDataFormat := GL_UNSIGNED_BYTE;
  2191. end;
  2192. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2193. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2194. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2195. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2196. begin
  2197. aData^ := aPixel.Data.b;
  2198. inc(aData);
  2199. aData^ := aPixel.Data.g;
  2200. inc(aData);
  2201. aData^ := aPixel.Data.r;
  2202. inc(aData);
  2203. end;
  2204. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2205. begin
  2206. aPixel.Data.b := aData^;
  2207. inc(aData);
  2208. aPixel.Data.g := aData^;
  2209. inc(aData);
  2210. aPixel.Data.r := aData^;
  2211. inc(aData);
  2212. aPixel.Data.a := 0;
  2213. end;
  2214. constructor TfdBGR_UB3.Create;
  2215. begin
  2216. fPixelSize := 3.0;
  2217. fRange.r := $FF;
  2218. fRange.g := $FF;
  2219. fRange.b := $FF;
  2220. fShift.r := 16;
  2221. fShift.g := 8;
  2222. fShift.b := 0;
  2223. fglFormat := GL_BGR;
  2224. fglDataFormat := GL_UNSIGNED_BYTE;
  2225. end;
  2226. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2227. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2229. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2230. begin
  2231. inherited Map(aPixel, aData, aMapData);
  2232. aData^ := aPixel.Data.a;
  2233. inc(aData);
  2234. end;
  2235. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2236. begin
  2237. inherited Unmap(aData, aPixel, aMapData);
  2238. aPixel.Data.a := aData^;
  2239. inc(aData);
  2240. end;
  2241. constructor TfdRGBA_UB4.Create;
  2242. begin
  2243. inherited Create;
  2244. fPixelSize := 4.0;
  2245. fRange.a := $FF;
  2246. fShift.a := 24;
  2247. fglFormat := GL_RGBA;
  2248. fglDataFormat := GL_UNSIGNED_BYTE;
  2249. end;
  2250. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2251. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2252. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2253. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2254. begin
  2255. inherited Map(aPixel, aData, aMapData);
  2256. aData^ := aPixel.Data.a;
  2257. inc(aData);
  2258. end;
  2259. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2260. begin
  2261. inherited Unmap(aData, aPixel, aMapData);
  2262. aPixel.Data.a := aData^;
  2263. inc(aData);
  2264. end;
  2265. constructor TfdBGRA_UB4.Create;
  2266. begin
  2267. inherited Create;
  2268. fPixelSize := 4.0;
  2269. fRange.a := $FF;
  2270. fShift.a := 24;
  2271. fglFormat := GL_BGRA;
  2272. fglDataFormat := GL_UNSIGNED_BYTE;
  2273. end;
  2274. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2275. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2276. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2277. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2278. begin
  2279. PWord(aData)^ := aPixel.Data.a;
  2280. inc(aData, 2);
  2281. end;
  2282. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2283. begin
  2284. aPixel.Data.r := 0;
  2285. aPixel.Data.g := 0;
  2286. aPixel.Data.b := 0;
  2287. aPixel.Data.a := PWord(aData)^;
  2288. inc(aData, 2);
  2289. end;
  2290. constructor TfdAlpha_US1.Create;
  2291. begin
  2292. inherited Create;
  2293. fPixelSize := 2.0;
  2294. fRange.a := $FFFF;
  2295. fglFormat := GL_ALPHA;
  2296. fglDataFormat := GL_UNSIGNED_SHORT;
  2297. end;
  2298. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2299. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2300. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2301. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2302. begin
  2303. PWord(aData)^ := LuminanceWeight(aPixel);
  2304. inc(aData, 2);
  2305. end;
  2306. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2307. begin
  2308. aPixel.Data.r := PWord(aData)^;
  2309. aPixel.Data.g := PWord(aData)^;
  2310. aPixel.Data.b := PWord(aData)^;
  2311. aPixel.Data.a := 0;
  2312. inc(aData, 2);
  2313. end;
  2314. constructor TfdLuminance_US1.Create;
  2315. begin
  2316. inherited Create;
  2317. fPixelSize := 2.0;
  2318. fRange.r := $FFFF;
  2319. fRange.g := $FFFF;
  2320. fRange.b := $FFFF;
  2321. fglFormat := GL_LUMINANCE;
  2322. fglDataFormat := GL_UNSIGNED_SHORT;
  2323. end;
  2324. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2325. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2326. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2327. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2328. var
  2329. i: Integer;
  2330. begin
  2331. PWord(aData)^ := 0;
  2332. for i := 0 to 3 do
  2333. if (fRange.arr[i] > 0) then
  2334. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2335. inc(aData, 2);
  2336. end;
  2337. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2338. var
  2339. i: Integer;
  2340. begin
  2341. for i := 0 to 3 do
  2342. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2343. inc(aData, 2);
  2344. end;
  2345. constructor TfdUniversal_US1.Create;
  2346. begin
  2347. inherited Create;
  2348. fPixelSize := 2.0;
  2349. end;
  2350. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2351. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2353. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2354. begin
  2355. PWord(aData)^ := DepthWeight(aPixel);
  2356. inc(aData, 2);
  2357. end;
  2358. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2359. begin
  2360. aPixel.Data.r := PWord(aData)^;
  2361. aPixel.Data.g := PWord(aData)^;
  2362. aPixel.Data.b := PWord(aData)^;
  2363. aPixel.Data.a := 0;
  2364. inc(aData, 2);
  2365. end;
  2366. constructor TfdDepth_US1.Create;
  2367. begin
  2368. inherited Create;
  2369. fPixelSize := 2.0;
  2370. fRange.r := $FFFF;
  2371. fRange.g := $FFFF;
  2372. fRange.b := $FFFF;
  2373. fglFormat := GL_DEPTH_COMPONENT;
  2374. fglDataFormat := GL_UNSIGNED_SHORT;
  2375. end;
  2376. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2377. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2378. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2379. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2380. begin
  2381. inherited Map(aPixel, aData, aMapData);
  2382. PWord(aData)^ := aPixel.Data.a;
  2383. inc(aData, 2);
  2384. end;
  2385. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2386. begin
  2387. inherited Unmap(aData, aPixel, aMapData);
  2388. aPixel.Data.a := PWord(aData)^;
  2389. inc(aData, 2);
  2390. end;
  2391. constructor TfdLuminanceAlpha_US2.Create;
  2392. begin
  2393. inherited Create;
  2394. fPixelSize := 4.0;
  2395. fRange.a := $FFFF;
  2396. fShift.a := 16;
  2397. fglFormat := GL_LUMINANCE_ALPHA;
  2398. fglDataFormat := GL_UNSIGNED_SHORT;
  2399. end;
  2400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2401. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2402. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2403. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2404. begin
  2405. PWord(aData)^ := aPixel.Data.r;
  2406. inc(aData, 2);
  2407. PWord(aData)^ := aPixel.Data.g;
  2408. inc(aData, 2);
  2409. PWord(aData)^ := aPixel.Data.b;
  2410. inc(aData, 2);
  2411. end;
  2412. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2413. begin
  2414. aPixel.Data.r := PWord(aData)^;
  2415. inc(aData, 2);
  2416. aPixel.Data.g := PWord(aData)^;
  2417. inc(aData, 2);
  2418. aPixel.Data.b := PWord(aData)^;
  2419. inc(aData, 2);
  2420. aPixel.Data.a := 0;
  2421. end;
  2422. constructor TfdRGB_US3.Create;
  2423. begin
  2424. inherited Create;
  2425. fPixelSize := 6.0;
  2426. fRange.r := $FFFF;
  2427. fRange.g := $FFFF;
  2428. fRange.b := $FFFF;
  2429. fShift.r := 0;
  2430. fShift.g := 16;
  2431. fShift.b := 32;
  2432. fglFormat := GL_RGB;
  2433. fglDataFormat := GL_UNSIGNED_SHORT;
  2434. end;
  2435. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2436. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2437. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2438. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2439. begin
  2440. PWord(aData)^ := aPixel.Data.b;
  2441. inc(aData, 2);
  2442. PWord(aData)^ := aPixel.Data.g;
  2443. inc(aData, 2);
  2444. PWord(aData)^ := aPixel.Data.r;
  2445. inc(aData, 2);
  2446. end;
  2447. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2448. begin
  2449. aPixel.Data.b := PWord(aData)^;
  2450. inc(aData, 2);
  2451. aPixel.Data.g := PWord(aData)^;
  2452. inc(aData, 2);
  2453. aPixel.Data.r := PWord(aData)^;
  2454. inc(aData, 2);
  2455. aPixel.Data.a := 0;
  2456. end;
  2457. constructor TfdBGR_US3.Create;
  2458. begin
  2459. inherited Create;
  2460. fPixelSize := 6.0;
  2461. fRange.r := $FFFF;
  2462. fRange.g := $FFFF;
  2463. fRange.b := $FFFF;
  2464. fShift.r := 32;
  2465. fShift.g := 16;
  2466. fShift.b := 0;
  2467. fglFormat := GL_BGR;
  2468. fglDataFormat := GL_UNSIGNED_SHORT;
  2469. end;
  2470. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2471. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2473. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2474. begin
  2475. inherited Map(aPixel, aData, aMapData);
  2476. PWord(aData)^ := aPixel.Data.a;
  2477. inc(aData, 2);
  2478. end;
  2479. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2480. begin
  2481. inherited Unmap(aData, aPixel, aMapData);
  2482. aPixel.Data.a := PWord(aData)^;
  2483. inc(aData, 2);
  2484. end;
  2485. constructor TfdRGBA_US4.Create;
  2486. begin
  2487. inherited Create;
  2488. fPixelSize := 8.0;
  2489. fRange.a := $FFFF;
  2490. fShift.a := 48;
  2491. fglFormat := GL_RGBA;
  2492. fglDataFormat := GL_UNSIGNED_SHORT;
  2493. end;
  2494. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2495. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2496. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2497. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2498. begin
  2499. inherited Map(aPixel, aData, aMapData);
  2500. PWord(aData)^ := aPixel.Data.a;
  2501. inc(aData, 2);
  2502. end;
  2503. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2504. begin
  2505. inherited Unmap(aData, aPixel, aMapData);
  2506. aPixel.Data.a := PWord(aData)^;
  2507. inc(aData, 2);
  2508. end;
  2509. constructor TfdBGRA_US4.Create;
  2510. begin
  2511. inherited Create;
  2512. fPixelSize := 8.0;
  2513. fRange.a := $FFFF;
  2514. fShift.a := 48;
  2515. fglFormat := GL_BGRA;
  2516. fglDataFormat := GL_UNSIGNED_SHORT;
  2517. end;
  2518. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2519. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2520. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2521. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2522. var
  2523. i: Integer;
  2524. begin
  2525. PCardinal(aData)^ := 0;
  2526. for i := 0 to 3 do
  2527. if (fRange.arr[i] > 0) then
  2528. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2529. inc(aData, 4);
  2530. end;
  2531. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2532. var
  2533. i: Integer;
  2534. begin
  2535. for i := 0 to 3 do
  2536. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2537. inc(aData, 2);
  2538. end;
  2539. constructor TfdUniversal_UI1.Create;
  2540. begin
  2541. inherited Create;
  2542. fPixelSize := 4.0;
  2543. end;
  2544. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2545. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2546. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2547. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2548. begin
  2549. PCardinal(aData)^ := DepthWeight(aPixel);
  2550. inc(aData, 4);
  2551. end;
  2552. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2553. begin
  2554. aPixel.Data.r := PCardinal(aData)^;
  2555. aPixel.Data.g := PCardinal(aData)^;
  2556. aPixel.Data.b := PCardinal(aData)^;
  2557. aPixel.Data.a := 0;
  2558. inc(aData, 4);
  2559. end;
  2560. constructor TfdDepth_UI1.Create;
  2561. begin
  2562. inherited Create;
  2563. fPixelSize := 4.0;
  2564. fRange.r := $FFFFFFFF;
  2565. fRange.g := $FFFFFFFF;
  2566. fRange.b := $FFFFFFFF;
  2567. fglFormat := GL_DEPTH_COMPONENT;
  2568. fglDataFormat := GL_UNSIGNED_INT;
  2569. end;
  2570. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2571. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2572. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2573. constructor TfdAlpha4.Create;
  2574. begin
  2575. inherited Create;
  2576. fFormat := tfAlpha4;
  2577. fWithAlpha := tfAlpha4;
  2578. fglInternalFormat := GL_ALPHA4;
  2579. end;
  2580. constructor TfdAlpha8.Create;
  2581. begin
  2582. inherited Create;
  2583. fFormat := tfAlpha8;
  2584. fWithAlpha := tfAlpha8;
  2585. fglInternalFormat := GL_ALPHA8;
  2586. end;
  2587. constructor TfdAlpha12.Create;
  2588. begin
  2589. inherited Create;
  2590. fFormat := tfAlpha12;
  2591. fWithAlpha := tfAlpha12;
  2592. fglInternalFormat := GL_ALPHA12;
  2593. end;
  2594. constructor TfdAlpha16.Create;
  2595. begin
  2596. inherited Create;
  2597. fFormat := tfAlpha16;
  2598. fWithAlpha := tfAlpha16;
  2599. fglInternalFormat := GL_ALPHA16;
  2600. end;
  2601. constructor TfdLuminance4.Create;
  2602. begin
  2603. inherited Create;
  2604. fFormat := tfLuminance4;
  2605. fWithAlpha := tfLuminance4Alpha4;
  2606. fWithoutAlpha := tfLuminance4;
  2607. fglInternalFormat := GL_LUMINANCE4;
  2608. end;
  2609. constructor TfdLuminance8.Create;
  2610. begin
  2611. inherited Create;
  2612. fFormat := tfLuminance8;
  2613. fWithAlpha := tfLuminance8Alpha8;
  2614. fWithoutAlpha := tfLuminance8;
  2615. fglInternalFormat := GL_LUMINANCE8;
  2616. end;
  2617. constructor TfdLuminance12.Create;
  2618. begin
  2619. inherited Create;
  2620. fFormat := tfLuminance12;
  2621. fWithAlpha := tfLuminance12Alpha12;
  2622. fWithoutAlpha := tfLuminance12;
  2623. fglInternalFormat := GL_LUMINANCE12;
  2624. end;
  2625. constructor TfdLuminance16.Create;
  2626. begin
  2627. inherited Create;
  2628. fFormat := tfLuminance16;
  2629. fWithAlpha := tfLuminance16Alpha16;
  2630. fWithoutAlpha := tfLuminance16;
  2631. fglInternalFormat := GL_LUMINANCE16;
  2632. end;
  2633. constructor TfdLuminance4Alpha4.Create;
  2634. begin
  2635. inherited Create;
  2636. fFormat := tfLuminance4Alpha4;
  2637. fWithAlpha := tfLuminance4Alpha4;
  2638. fWithoutAlpha := tfLuminance4;
  2639. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2640. end;
  2641. constructor TfdLuminance6Alpha2.Create;
  2642. begin
  2643. inherited Create;
  2644. fFormat := tfLuminance6Alpha2;
  2645. fWithAlpha := tfLuminance6Alpha2;
  2646. fWithoutAlpha := tfLuminance8;
  2647. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2648. end;
  2649. constructor TfdLuminance8Alpha8.Create;
  2650. begin
  2651. inherited Create;
  2652. fFormat := tfLuminance8Alpha8;
  2653. fWithAlpha := tfLuminance8Alpha8;
  2654. fWithoutAlpha := tfLuminance8;
  2655. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2656. end;
  2657. constructor TfdLuminance12Alpha4.Create;
  2658. begin
  2659. inherited Create;
  2660. fFormat := tfLuminance12Alpha4;
  2661. fWithAlpha := tfLuminance12Alpha4;
  2662. fWithoutAlpha := tfLuminance12;
  2663. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2664. end;
  2665. constructor TfdLuminance12Alpha12.Create;
  2666. begin
  2667. inherited Create;
  2668. fFormat := tfLuminance12Alpha12;
  2669. fWithAlpha := tfLuminance12Alpha12;
  2670. fWithoutAlpha := tfLuminance12;
  2671. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2672. end;
  2673. constructor TfdLuminance16Alpha16.Create;
  2674. begin
  2675. inherited Create;
  2676. fFormat := tfLuminance16Alpha16;
  2677. fWithAlpha := tfLuminance16Alpha16;
  2678. fWithoutAlpha := tfLuminance16;
  2679. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2680. end;
  2681. constructor TfdR3G3B2.Create;
  2682. begin
  2683. inherited Create;
  2684. fFormat := tfR3G3B2;
  2685. fWithAlpha := tfRGBA2;
  2686. fWithoutAlpha := tfR3G3B2;
  2687. fRange.r := $7;
  2688. fRange.g := $7;
  2689. fRange.b := $3;
  2690. fShift.r := 0;
  2691. fShift.g := 3;
  2692. fShift.b := 6;
  2693. fglFormat := GL_RGB;
  2694. fglInternalFormat := GL_R3_G3_B2;
  2695. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2696. end;
  2697. constructor TfdRGB4.Create;
  2698. begin
  2699. inherited Create;
  2700. fFormat := tfRGB4;
  2701. fWithAlpha := tfRGBA4;
  2702. fWithoutAlpha := tfRGB4;
  2703. fRGBInverted := tfBGR4;
  2704. fRange.r := $F;
  2705. fRange.g := $F;
  2706. fRange.b := $F;
  2707. fShift.r := 0;
  2708. fShift.g := 4;
  2709. fShift.b := 8;
  2710. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2711. fglInternalFormat := GL_RGB4;
  2712. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2713. end;
  2714. constructor TfdR5G6B5.Create;
  2715. begin
  2716. inherited Create;
  2717. fFormat := tfR5G6B5;
  2718. fWithAlpha := tfRGBA4;
  2719. fWithoutAlpha := tfR5G6B5;
  2720. fRGBInverted := tfB5G6R5;
  2721. fRange.r := $1F;
  2722. fRange.g := $3F;
  2723. fRange.b := $1F;
  2724. fShift.r := 0;
  2725. fShift.g := 5;
  2726. fShift.b := 11;
  2727. fglFormat := GL_RGB;
  2728. fglInternalFormat := GL_RGB565;
  2729. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2730. end;
  2731. constructor TfdRGB5.Create;
  2732. begin
  2733. inherited Create;
  2734. fFormat := tfRGB5;
  2735. fWithAlpha := tfRGB5A1;
  2736. fWithoutAlpha := tfRGB5;
  2737. fRGBInverted := tfBGR5;
  2738. fRange.r := $1F;
  2739. fRange.g := $1F;
  2740. fRange.b := $1F;
  2741. fShift.r := 0;
  2742. fShift.g := 5;
  2743. fShift.b := 10;
  2744. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2745. fglInternalFormat := GL_RGB5;
  2746. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2747. end;
  2748. constructor TfdRGB8.Create;
  2749. begin
  2750. inherited Create;
  2751. fFormat := tfRGB8;
  2752. fWithAlpha := tfRGBA8;
  2753. fWithoutAlpha := tfRGB8;
  2754. fRGBInverted := tfBGR8;
  2755. fglInternalFormat := GL_RGB8;
  2756. end;
  2757. constructor TfdRGB10.Create;
  2758. begin
  2759. inherited Create;
  2760. fFormat := tfRGB10;
  2761. fWithAlpha := tfRGB10A2;
  2762. fWithoutAlpha := tfRGB10;
  2763. fRGBInverted := tfBGR10;
  2764. fRange.r := $3FF;
  2765. fRange.g := $3FF;
  2766. fRange.b := $3FF;
  2767. fShift.r := 0;
  2768. fShift.g := 10;
  2769. fShift.b := 20;
  2770. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2771. fglInternalFormat := GL_RGB10;
  2772. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2773. end;
  2774. constructor TfdRGB12.Create;
  2775. begin
  2776. inherited Create;
  2777. fFormat := tfRGB12;
  2778. fWithAlpha := tfRGBA12;
  2779. fWithoutAlpha := tfRGB12;
  2780. fRGBInverted := tfBGR12;
  2781. fglInternalFormat := GL_RGB12;
  2782. end;
  2783. constructor TfdRGB16.Create;
  2784. begin
  2785. inherited Create;
  2786. fFormat := tfRGB16;
  2787. fWithAlpha := tfRGBA16;
  2788. fWithoutAlpha := tfRGB16;
  2789. fRGBInverted := tfBGR16;
  2790. fglInternalFormat := GL_RGB16;
  2791. end;
  2792. constructor TfdRGBA2.Create;
  2793. begin
  2794. inherited Create;
  2795. fFormat := tfRGBA2;
  2796. fWithAlpha := tfRGBA2;
  2797. fWithoutAlpha := tfR3G3B2;
  2798. fRGBInverted := tfBGRA2;
  2799. fglInternalFormat := GL_RGBA2;
  2800. end;
  2801. constructor TfdRGBA4.Create;
  2802. begin
  2803. inherited Create;
  2804. fFormat := tfRGBA4;
  2805. fWithAlpha := tfRGBA4;
  2806. fWithoutAlpha := tfRGB4;
  2807. fRGBInverted := tfBGRA4;
  2808. fRange.r := $F;
  2809. fRange.g := $F;
  2810. fRange.b := $F;
  2811. fRange.a := $F;
  2812. fShift.r := 0;
  2813. fShift.g := 4;
  2814. fShift.b := 8;
  2815. fShift.a := 12;
  2816. fglFormat := GL_RGBA;
  2817. fglInternalFormat := GL_RGBA4;
  2818. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2819. end;
  2820. constructor TfdRGB5A1.Create;
  2821. begin
  2822. inherited Create;
  2823. fFormat := tfRGB5A1;
  2824. fWithAlpha := tfRGB5A1;
  2825. fWithoutAlpha := tfRGB5;
  2826. fRGBInverted := tfBGR5A1;
  2827. fRange.r := $1F;
  2828. fRange.g := $1F;
  2829. fRange.b := $1F;
  2830. fRange.a := $01;
  2831. fShift.r := 0;
  2832. fShift.g := 5;
  2833. fShift.b := 10;
  2834. fShift.a := 15;
  2835. fglFormat := GL_RGBA;
  2836. fglInternalFormat := GL_RGB5_A1;
  2837. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2838. end;
  2839. constructor TfdRGBA8.Create;
  2840. begin
  2841. inherited Create;
  2842. fFormat := tfRGBA8;
  2843. fWithAlpha := tfRGBA8;
  2844. fWithoutAlpha := tfRGB8;
  2845. fRGBInverted := tfBGRA8;
  2846. fglInternalFormat := GL_RGBA8;
  2847. end;
  2848. constructor TfdRGB10A2.Create;
  2849. begin
  2850. inherited Create;
  2851. fFormat := tfRGB10A2;
  2852. fWithAlpha := tfRGB10A2;
  2853. fWithoutAlpha := tfRGB10;
  2854. fRGBInverted := tfBGR10A2;
  2855. fRange.r := $3FF;
  2856. fRange.g := $3FF;
  2857. fRange.b := $3FF;
  2858. fRange.a := $003;
  2859. fShift.r := 0;
  2860. fShift.g := 10;
  2861. fShift.b := 20;
  2862. fShift.a := 30;
  2863. fglFormat := GL_RGBA;
  2864. fglInternalFormat := GL_RGB10_A2;
  2865. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2866. end;
  2867. constructor TfdRGBA12.Create;
  2868. begin
  2869. inherited Create;
  2870. fFormat := tfRGBA12;
  2871. fWithAlpha := tfRGBA12;
  2872. fWithoutAlpha := tfRGB12;
  2873. fRGBInverted := tfBGRA12;
  2874. fglInternalFormat := GL_RGBA12;
  2875. end;
  2876. constructor TfdRGBA16.Create;
  2877. begin
  2878. inherited Create;
  2879. fFormat := tfRGBA16;
  2880. fWithAlpha := tfRGBA16;
  2881. fWithoutAlpha := tfRGB16;
  2882. fRGBInverted := tfBGRA16;
  2883. fglInternalFormat := GL_RGBA16;
  2884. end;
  2885. constructor TfdBGR4.Create;
  2886. begin
  2887. inherited Create;
  2888. fPixelSize := 2.0;
  2889. fFormat := tfBGR4;
  2890. fWithAlpha := tfBGRA4;
  2891. fWithoutAlpha := tfBGR4;
  2892. fRGBInverted := tfRGB4;
  2893. fRange.r := $F;
  2894. fRange.g := $F;
  2895. fRange.b := $F;
  2896. fRange.a := $0;
  2897. fShift.r := 8;
  2898. fShift.g := 4;
  2899. fShift.b := 0;
  2900. fShift.a := 0;
  2901. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2902. fglInternalFormat := GL_RGB4;
  2903. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2904. end;
  2905. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2906. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2908. constructor TfdB5G6R5.Create;
  2909. begin
  2910. inherited Create;
  2911. fFormat := tfB5G6R5;
  2912. fWithAlpha := tfBGRA4;
  2913. fWithoutAlpha := tfB5G6R5;
  2914. fRGBInverted := tfR5G6B5;
  2915. fRange.r := $1F;
  2916. fRange.g := $3F;
  2917. fRange.b := $1F;
  2918. fShift.r := 11;
  2919. fShift.g := 5;
  2920. fShift.b := 0;
  2921. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2922. fglInternalFormat := GL_RGB8;
  2923. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2924. end;
  2925. constructor TfdBGR5.Create;
  2926. begin
  2927. inherited Create;
  2928. fPixelSize := 2.0;
  2929. fFormat := tfBGR5;
  2930. fWithAlpha := tfBGR5A1;
  2931. fWithoutAlpha := tfBGR5;
  2932. fRGBInverted := tfRGB5;
  2933. fRange.r := $1F;
  2934. fRange.g := $1F;
  2935. fRange.b := $1F;
  2936. fRange.a := $00;
  2937. fShift.r := 10;
  2938. fShift.g := 5;
  2939. fShift.b := 0;
  2940. fShift.a := 0;
  2941. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2942. fglInternalFormat := GL_RGB5;
  2943. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2944. end;
  2945. constructor TfdBGR8.Create;
  2946. begin
  2947. inherited Create;
  2948. fFormat := tfBGR8;
  2949. fWithAlpha := tfBGRA8;
  2950. fWithoutAlpha := tfBGR8;
  2951. fRGBInverted := tfRGB8;
  2952. fglInternalFormat := GL_RGB8;
  2953. end;
  2954. constructor TfdBGR10.Create;
  2955. begin
  2956. inherited Create;
  2957. fFormat := tfBGR10;
  2958. fWithAlpha := tfBGR10A2;
  2959. fWithoutAlpha := tfBGR10;
  2960. fRGBInverted := tfRGB10;
  2961. fRange.r := $3FF;
  2962. fRange.g := $3FF;
  2963. fRange.b := $3FF;
  2964. fRange.a := $000;
  2965. fShift.r := 20;
  2966. fShift.g := 10;
  2967. fShift.b := 0;
  2968. fShift.a := 0;
  2969. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2970. fglInternalFormat := GL_RGB10;
  2971. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2972. end;
  2973. constructor TfdBGR12.Create;
  2974. begin
  2975. inherited Create;
  2976. fFormat := tfBGR12;
  2977. fWithAlpha := tfBGRA12;
  2978. fWithoutAlpha := tfBGR12;
  2979. fRGBInverted := tfRGB12;
  2980. fglInternalFormat := GL_RGB12;
  2981. end;
  2982. constructor TfdBGR16.Create;
  2983. begin
  2984. inherited Create;
  2985. fFormat := tfBGR16;
  2986. fWithAlpha := tfBGRA16;
  2987. fWithoutAlpha := tfBGR16;
  2988. fRGBInverted := tfRGB16;
  2989. fglInternalFormat := GL_RGB16;
  2990. end;
  2991. constructor TfdBGRA2.Create;
  2992. begin
  2993. inherited Create;
  2994. fFormat := tfBGRA2;
  2995. fWithAlpha := tfBGRA4;
  2996. fWithoutAlpha := tfBGR4;
  2997. fRGBInverted := tfRGBA2;
  2998. fglInternalFormat := GL_RGBA2;
  2999. end;
  3000. constructor TfdBGRA4.Create;
  3001. begin
  3002. inherited Create;
  3003. fFormat := tfBGRA4;
  3004. fWithAlpha := tfBGRA4;
  3005. fWithoutAlpha := tfBGR4;
  3006. fRGBInverted := tfRGBA4;
  3007. fRange.r := $F;
  3008. fRange.g := $F;
  3009. fRange.b := $F;
  3010. fRange.a := $F;
  3011. fShift.r := 8;
  3012. fShift.g := 4;
  3013. fShift.b := 0;
  3014. fShift.a := 12;
  3015. fglFormat := GL_BGRA;
  3016. fglInternalFormat := GL_RGBA4;
  3017. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3018. end;
  3019. constructor TfdBGR5A1.Create;
  3020. begin
  3021. inherited Create;
  3022. fFormat := tfBGR5A1;
  3023. fWithAlpha := tfBGR5A1;
  3024. fWithoutAlpha := tfBGR5;
  3025. fRGBInverted := tfRGB5A1;
  3026. fRange.r := $1F;
  3027. fRange.g := $1F;
  3028. fRange.b := $1F;
  3029. fRange.a := $01;
  3030. fShift.r := 10;
  3031. fShift.g := 5;
  3032. fShift.b := 0;
  3033. fShift.a := 15;
  3034. fglFormat := GL_BGRA;
  3035. fglInternalFormat := GL_RGB5_A1;
  3036. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3037. end;
  3038. constructor TfdBGRA8.Create;
  3039. begin
  3040. inherited Create;
  3041. fFormat := tfBGRA8;
  3042. fWithAlpha := tfBGRA8;
  3043. fWithoutAlpha := tfBGR8;
  3044. fRGBInverted := tfRGBA8;
  3045. fglInternalFormat := GL_RGBA8;
  3046. end;
  3047. constructor TfdBGR10A2.Create;
  3048. begin
  3049. inherited Create;
  3050. fFormat := tfBGR10A2;
  3051. fWithAlpha := tfBGR10A2;
  3052. fWithoutAlpha := tfBGR10;
  3053. fRGBInverted := tfRGB10A2;
  3054. fRange.r := $3FF;
  3055. fRange.g := $3FF;
  3056. fRange.b := $3FF;
  3057. fRange.a := $003;
  3058. fShift.r := 20;
  3059. fShift.g := 10;
  3060. fShift.b := 0;
  3061. fShift.a := 30;
  3062. fglFormat := GL_BGRA;
  3063. fglInternalFormat := GL_RGB10_A2;
  3064. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3065. end;
  3066. constructor TfdBGRA12.Create;
  3067. begin
  3068. inherited Create;
  3069. fFormat := tfBGRA12;
  3070. fWithAlpha := tfBGRA12;
  3071. fWithoutAlpha := tfBGR12;
  3072. fRGBInverted := tfRGBA12;
  3073. fglInternalFormat := GL_RGBA12;
  3074. end;
  3075. constructor TfdBGRA16.Create;
  3076. begin
  3077. inherited Create;
  3078. fFormat := tfBGRA16;
  3079. fWithAlpha := tfBGRA16;
  3080. fWithoutAlpha := tfBGR16;
  3081. fRGBInverted := tfRGBA16;
  3082. fglInternalFormat := GL_RGBA16;
  3083. end;
  3084. constructor TfdDepth16.Create;
  3085. begin
  3086. inherited Create;
  3087. fFormat := tfDepth16;
  3088. fWithAlpha := tfEmpty;
  3089. fWithoutAlpha := tfDepth16;
  3090. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3091. end;
  3092. constructor TfdDepth24.Create;
  3093. begin
  3094. inherited Create;
  3095. fFormat := tfDepth24;
  3096. fWithAlpha := tfEmpty;
  3097. fWithoutAlpha := tfDepth24;
  3098. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3099. end;
  3100. constructor TfdDepth32.Create;
  3101. begin
  3102. inherited Create;
  3103. fFormat := tfDepth32;
  3104. fWithAlpha := tfEmpty;
  3105. fWithoutAlpha := tfDepth32;
  3106. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3107. end;
  3108. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3109. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3110. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3111. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3112. begin
  3113. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3114. end;
  3115. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3116. begin
  3117. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3118. end;
  3119. constructor TfdS3tcDtx1RGBA.Create;
  3120. begin
  3121. inherited Create;
  3122. fFormat := tfS3tcDtx1RGBA;
  3123. fWithAlpha := tfS3tcDtx1RGBA;
  3124. fUncompressed := tfRGB5A1;
  3125. fPixelSize := 0.5;
  3126. fIsCompressed := true;
  3127. fglFormat := GL_COMPRESSED_RGBA;
  3128. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3129. fglDataFormat := GL_UNSIGNED_BYTE;
  3130. end;
  3131. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3132. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3133. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3134. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3135. begin
  3136. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3137. end;
  3138. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3139. begin
  3140. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3141. end;
  3142. constructor TfdS3tcDtx3RGBA.Create;
  3143. begin
  3144. inherited Create;
  3145. fFormat := tfS3tcDtx3RGBA;
  3146. fWithAlpha := tfS3tcDtx3RGBA;
  3147. fUncompressed := tfRGBA8;
  3148. fPixelSize := 1.0;
  3149. fIsCompressed := true;
  3150. fglFormat := GL_COMPRESSED_RGBA;
  3151. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3152. fglDataFormat := GL_UNSIGNED_BYTE;
  3153. end;
  3154. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3155. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3156. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3157. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3158. begin
  3159. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3160. end;
  3161. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3162. begin
  3163. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3164. end;
  3165. constructor TfdS3tcDtx5RGBA.Create;
  3166. begin
  3167. inherited Create;
  3168. fFormat := tfS3tcDtx3RGBA;
  3169. fWithAlpha := tfS3tcDtx3RGBA;
  3170. fUncompressed := tfRGBA8;
  3171. fPixelSize := 1.0;
  3172. fIsCompressed := true;
  3173. fglFormat := GL_COMPRESSED_RGBA;
  3174. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3175. fglDataFormat := GL_UNSIGNED_BYTE;
  3176. end;
  3177. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3178. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3179. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3180. class procedure TFormatDescriptor.Init;
  3181. begin
  3182. if not Assigned(FormatDescriptorCS) then
  3183. FormatDescriptorCS := TCriticalSection.Create;
  3184. end;
  3185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3186. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3187. begin
  3188. FormatDescriptorCS.Enter;
  3189. try
  3190. result := FormatDescriptors[aFormat];
  3191. if not Assigned(result) then begin
  3192. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3193. FormatDescriptors[aFormat] := result;
  3194. end;
  3195. finally
  3196. FormatDescriptorCS.Leave;
  3197. end;
  3198. end;
  3199. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3200. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3201. begin
  3202. result := Get(Get(aFormat).WithAlpha);
  3203. end;
  3204. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3205. class procedure TFormatDescriptor.Clear;
  3206. var
  3207. f: TglBitmapFormat;
  3208. begin
  3209. FormatDescriptorCS.Enter;
  3210. try
  3211. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3212. FreeAndNil(FormatDescriptors[f]);
  3213. finally
  3214. FormatDescriptorCS.Leave;
  3215. end;
  3216. end;
  3217. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3218. class procedure TFormatDescriptor.Finalize;
  3219. begin
  3220. Clear;
  3221. FreeAndNil(FormatDescriptorCS);
  3222. end;
  3223. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3224. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3225. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3226. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3227. begin
  3228. Update(aValue, fRange.r, fShift.r);
  3229. end;
  3230. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3231. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3232. begin
  3233. Update(aValue, fRange.g, fShift.g);
  3234. end;
  3235. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3236. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3237. begin
  3238. Update(aValue, fRange.b, fShift.b);
  3239. end;
  3240. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3241. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3242. begin
  3243. Update(aValue, fRange.a, fShift.a);
  3244. end;
  3245. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3246. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3247. aShift: Byte);
  3248. begin
  3249. aShift := 0;
  3250. aRange := 0;
  3251. if (aMask = 0) then
  3252. exit;
  3253. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3254. inc(aShift);
  3255. aMask := aMask shr 1;
  3256. end;
  3257. aRange := 1;
  3258. while (aMask > 0) do begin
  3259. aRange := aRange shl 1;
  3260. aMask := aMask shr 1;
  3261. end;
  3262. dec(aRange);
  3263. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3264. end;
  3265. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3266. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3267. var
  3268. data: QWord;
  3269. s: Integer;
  3270. begin
  3271. data :=
  3272. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3273. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3274. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3275. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3276. s := Round(fPixelSize);
  3277. case s of
  3278. 1: aData^ := data;
  3279. 2: PWord(aData)^ := data;
  3280. 4: PCardinal(aData)^ := data;
  3281. 8: PQWord(aData)^ := data;
  3282. else
  3283. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3284. end;
  3285. inc(aData, s);
  3286. end;
  3287. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3288. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3289. var
  3290. data: QWord;
  3291. s, i: Integer;
  3292. begin
  3293. s := Round(fPixelSize);
  3294. case s of
  3295. 1: data := aData^;
  3296. 2: data := PWord(aData)^;
  3297. 4: data := PCardinal(aData)^;
  3298. 8: data := PQWord(aData)^;
  3299. else
  3300. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3301. end;
  3302. for i := 0 to 3 do
  3303. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3304. inc(aData, s);
  3305. end;
  3306. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3307. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3308. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3309. procedure TbmpColorTableFormat.CreateColorTable;
  3310. var
  3311. i: Integer;
  3312. begin
  3313. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3314. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3315. if (Format = tfLuminance4) then
  3316. SetLength(fColorTable, 16)
  3317. else
  3318. SetLength(fColorTable, 256);
  3319. case Format of
  3320. tfLuminance4: begin
  3321. for i := 0 to High(fColorTable) do begin
  3322. fColorTable[i].r := 16 * i;
  3323. fColorTable[i].g := 16 * i;
  3324. fColorTable[i].b := 16 * i;
  3325. fColorTable[i].a := 0;
  3326. end;
  3327. end;
  3328. tfLuminance8: begin
  3329. for i := 0 to High(fColorTable) do begin
  3330. fColorTable[i].r := i;
  3331. fColorTable[i].g := i;
  3332. fColorTable[i].b := i;
  3333. fColorTable[i].a := 0;
  3334. end;
  3335. end;
  3336. tfR3G3B2: begin
  3337. for i := 0 to High(fColorTable) do begin
  3338. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3339. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3340. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3341. fColorTable[i].a := 0;
  3342. end;
  3343. end;
  3344. end;
  3345. end;
  3346. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3347. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3348. var
  3349. d: Byte;
  3350. begin
  3351. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3352. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3353. case Format of
  3354. tfLuminance4: begin
  3355. if (aMapData = nil) then
  3356. aData^ := 0;
  3357. d := LuminanceWeight(aPixel) and Range.r;
  3358. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3359. inc(PByte(aMapData), 4);
  3360. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3361. inc(aData);
  3362. aMapData := nil;
  3363. end;
  3364. end;
  3365. tfLuminance8: begin
  3366. aData^ := LuminanceWeight(aPixel) and Range.r;
  3367. inc(aData);
  3368. end;
  3369. tfR3G3B2: begin
  3370. aData^ := Round(
  3371. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3372. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3373. ((aPixel.Data.b and Range.b) shl Shift.b));
  3374. inc(aData);
  3375. end;
  3376. end;
  3377. end;
  3378. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3379. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3380. var
  3381. idx: QWord;
  3382. s: Integer;
  3383. bits: Byte;
  3384. f: Single;
  3385. begin
  3386. s := Trunc(fPixelSize);
  3387. f := fPixelSize - s;
  3388. bits := Round(8 * f);
  3389. case s of
  3390. 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
  3391. 1: idx := aData^;
  3392. 2: idx := PWord(aData)^;
  3393. 4: idx := PCardinal(aData)^;
  3394. 8: idx := PQWord(aData)^;
  3395. else
  3396. raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3397. end;
  3398. if (idx >= Length(fColorTable)) then
  3399. raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
  3400. with fColorTable[idx] do begin
  3401. aPixel.Data.r := r;
  3402. aPixel.Data.g := g;
  3403. aPixel.Data.b := b;
  3404. aPixel.Data.a := a;
  3405. end;
  3406. inc(PByte(aMapData), bits);
  3407. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3408. inc(aData, 1);
  3409. dec(PByte(aMapData), 8);
  3410. end;
  3411. inc(aData, s);
  3412. end;
  3413. destructor TbmpColorTableFormat.Destroy;
  3414. begin
  3415. SetLength(fColorTable, 0);
  3416. inherited Destroy;
  3417. end;
  3418. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3419. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3420. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3421. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3422. var
  3423. i: Integer;
  3424. begin
  3425. for i := 0 to 3 do begin
  3426. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3427. if (aSourceFD.Range.arr[i] > 0) then
  3428. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3429. else
  3430. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3431. end;
  3432. end;
  3433. end;
  3434. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3435. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3436. begin
  3437. with aFuncRec do begin
  3438. if (Source.Range.r > 0) then
  3439. Dest.Data.r := Source.Data.r;
  3440. if (Source.Range.g > 0) then
  3441. Dest.Data.g := Source.Data.g;
  3442. if (Source.Range.b > 0) then
  3443. Dest.Data.b := Source.Data.b;
  3444. if (Source.Range.a > 0) then
  3445. Dest.Data.a := Source.Data.a;
  3446. end;
  3447. end;
  3448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3449. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3450. var
  3451. i: Integer;
  3452. begin
  3453. with aFuncRec do begin
  3454. for i := 0 to 3 do
  3455. if (Source.Range.arr[i] > 0) then
  3456. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3457. end;
  3458. end;
  3459. type
  3460. TShiftData = packed record
  3461. case Integer of
  3462. 0: (r, g, b, a: SmallInt);
  3463. 1: (arr: array[0..3] of SmallInt);
  3464. end;
  3465. PShiftData = ^TShiftData;
  3466. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3467. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3468. var
  3469. i: Integer;
  3470. begin
  3471. with aFuncRec do
  3472. for i := 0 to 3 do
  3473. if (Source.Range.arr[i] > 0) then
  3474. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3475. end;
  3476. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3477. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3478. begin
  3479. with aFuncRec do begin
  3480. Dest.Data := Source.Data;
  3481. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3482. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3483. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3484. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3485. end;
  3486. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3487. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3488. end;
  3489. end;
  3490. end;
  3491. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3492. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3493. var
  3494. i: Integer;
  3495. begin
  3496. with aFuncRec do begin
  3497. for i := 0 to 3 do
  3498. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3499. end;
  3500. end;
  3501. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3502. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3503. var
  3504. Temp: Single;
  3505. begin
  3506. with FuncRec do begin
  3507. if (FuncRec.Args = nil) then begin //source has no alpha
  3508. Temp :=
  3509. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3510. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3511. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3512. Dest.Data.a := Round(Dest.Range.a * Temp);
  3513. end else
  3514. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3515. end;
  3516. end;
  3517. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3518. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3519. type
  3520. PglBitmapPixelData = ^TglBitmapPixelData;
  3521. begin
  3522. with FuncRec do begin
  3523. Dest.Data.r := Source.Data.r;
  3524. Dest.Data.g := Source.Data.g;
  3525. Dest.Data.b := Source.Data.b;
  3526. with PglBitmapPixelData(Args)^ do
  3527. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3528. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3529. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3530. Dest.Data.a := 0
  3531. else
  3532. Dest.Data.a := Dest.Range.a;
  3533. end;
  3534. end;
  3535. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3536. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3537. begin
  3538. with FuncRec do begin
  3539. Dest.Data.r := Source.Data.r;
  3540. Dest.Data.g := Source.Data.g;
  3541. Dest.Data.b := Source.Data.b;
  3542. Dest.Data.a := PCardinal(Args)^;
  3543. end;
  3544. end;
  3545. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3546. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3547. type
  3548. PRGBPix = ^TRGBPix;
  3549. TRGBPix = array [0..2] of byte;
  3550. var
  3551. Temp: Byte;
  3552. begin
  3553. while aWidth > 0 do begin
  3554. Temp := PRGBPix(aData)^[0];
  3555. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3556. PRGBPix(aData)^[2] := Temp;
  3557. if aHasAlpha then
  3558. Inc(aData, 4)
  3559. else
  3560. Inc(aData, 3);
  3561. dec(aWidth);
  3562. end;
  3563. end;
  3564. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3565. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3566. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3567. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  3568. begin
  3569. result := TFormatDescriptor.Get(Format);
  3570. end;
  3571. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3572. function TglBitmap.GetWidth: Integer;
  3573. begin
  3574. if (ffX in fDimension.Fields) then
  3575. result := fDimension.X
  3576. else
  3577. result := -1;
  3578. end;
  3579. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3580. function TglBitmap.GetHeight: Integer;
  3581. begin
  3582. if (ffY in fDimension.Fields) then
  3583. result := fDimension.Y
  3584. else
  3585. result := -1;
  3586. end;
  3587. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3588. function TglBitmap.GetFileWidth: Integer;
  3589. begin
  3590. result := Max(1, Width);
  3591. end;
  3592. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3593. function TglBitmap.GetFileHeight: Integer;
  3594. begin
  3595. result := Max(1, Height);
  3596. end;
  3597. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3598. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3599. begin
  3600. if fCustomData = aValue then
  3601. exit;
  3602. fCustomData := aValue;
  3603. end;
  3604. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3605. procedure TglBitmap.SetCustomName(const aValue: String);
  3606. begin
  3607. if fCustomName = aValue then
  3608. exit;
  3609. fCustomName := aValue;
  3610. end;
  3611. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3612. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3613. begin
  3614. if fCustomNameW = aValue then
  3615. exit;
  3616. fCustomNameW := aValue;
  3617. end;
  3618. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3619. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3620. begin
  3621. if fDeleteTextureOnFree = aValue then
  3622. exit;
  3623. fDeleteTextureOnFree := aValue;
  3624. end;
  3625. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3626. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3627. begin
  3628. if fFormat = aValue then
  3629. exit;
  3630. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3631. raise EglBitmapUnsupportedFormat.Create(Format);
  3632. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  3633. end;
  3634. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3635. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3636. begin
  3637. if fFreeDataAfterGenTexture = aValue then
  3638. exit;
  3639. fFreeDataAfterGenTexture := aValue;
  3640. end;
  3641. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3642. procedure TglBitmap.SetID(const aValue: Cardinal);
  3643. begin
  3644. if fID = aValue then
  3645. exit;
  3646. fID := aValue;
  3647. end;
  3648. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3649. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3650. begin
  3651. if fMipMap = aValue then
  3652. exit;
  3653. fMipMap := aValue;
  3654. end;
  3655. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3656. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3657. begin
  3658. if fTarget = aValue then
  3659. exit;
  3660. fTarget := aValue;
  3661. end;
  3662. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3663. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3664. var
  3665. MaxAnisotropic: Integer;
  3666. begin
  3667. fAnisotropic := aValue;
  3668. if (ID > 0) then begin
  3669. if GL_EXT_texture_filter_anisotropic then begin
  3670. if fAnisotropic > 0 then begin
  3671. Bind(false);
  3672. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3673. if aValue > MaxAnisotropic then
  3674. fAnisotropic := MaxAnisotropic;
  3675. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3676. end;
  3677. end else begin
  3678. fAnisotropic := 0;
  3679. end;
  3680. end;
  3681. end;
  3682. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3683. procedure TglBitmap.CreateID;
  3684. begin
  3685. if (ID <> 0) then
  3686. glDeleteTextures(1, @fID);
  3687. glGenTextures(1, @fID);
  3688. Bind(false);
  3689. end;
  3690. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3691. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3692. begin
  3693. // Set Up Parameters
  3694. SetWrap(fWrapS, fWrapT, fWrapR);
  3695. SetFilter(fFilterMin, fFilterMag);
  3696. SetAnisotropic(fAnisotropic);
  3697. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3698. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  3699. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3700. // Mip Maps Generation Mode
  3701. aBuildWithGlu := false;
  3702. if (MipMap = mmMipmap) then begin
  3703. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3704. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3705. else
  3706. aBuildWithGlu := true;
  3707. end else if (MipMap = mmMipmapGlu) then
  3708. aBuildWithGlu := true;
  3709. end;
  3710. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3711. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  3712. const aWidth: Integer; const aHeight: Integer);
  3713. var
  3714. s: Single;
  3715. begin
  3716. if (Data <> aData) then begin
  3717. if (Assigned(Data)) then
  3718. FreeMem(Data);
  3719. fData := aData;
  3720. end;
  3721. if not Assigned(fData) then begin
  3722. fPixelSize := 0;
  3723. fRowSize := 0;
  3724. end else begin
  3725. FillChar(fDimension, SizeOf(fDimension), 0);
  3726. if aWidth <> -1 then begin
  3727. fDimension.Fields := fDimension.Fields + [ffX];
  3728. fDimension.X := aWidth;
  3729. end;
  3730. if aHeight <> -1 then begin
  3731. fDimension.Fields := fDimension.Fields + [ffY];
  3732. fDimension.Y := aHeight;
  3733. end;
  3734. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3735. fFormat := aFormat;
  3736. fPixelSize := Ceil(s);
  3737. fRowSize := Ceil(s * aWidth);
  3738. end;
  3739. end;
  3740. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3741. function TglBitmap.FlipHorz: Boolean;
  3742. begin
  3743. result := false;
  3744. end;
  3745. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3746. function TglBitmap.FlipVert: Boolean;
  3747. begin
  3748. result := false;
  3749. end;
  3750. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3751. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3752. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3753. procedure TglBitmap.AfterConstruction;
  3754. begin
  3755. inherited AfterConstruction;
  3756. fID := 0;
  3757. fTarget := 0;
  3758. fIsResident := false;
  3759. fFormat := glBitmapGetDefaultFormat;
  3760. fMipMap := glBitmapDefaultMipmap;
  3761. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3762. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3763. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3764. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3765. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3766. end;
  3767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3768. procedure TglBitmap.BeforeDestruction;
  3769. var
  3770. NewData: PByte;
  3771. begin
  3772. NewData := nil;
  3773. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  3774. if (fID > 0) and fDeleteTextureOnFree then
  3775. glDeleteTextures(1, @fID);
  3776. inherited BeforeDestruction;
  3777. end;
  3778. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3779. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  3780. var
  3781. TempPos: Integer;
  3782. begin
  3783. if not Assigned(aResType) then begin
  3784. TempPos := Pos('.', aResource);
  3785. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3786. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3787. end;
  3788. end;
  3789. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3790. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3791. var
  3792. fs: TFileStream;
  3793. begin
  3794. if not FileExists(aFilename) then
  3795. raise EglBitmap.Create('file does not exist: ' + aFilename);
  3796. fFilename := aFilename;
  3797. fs := TFileStream.Create(fFilename, fmOpenRead);
  3798. try
  3799. fs.Position := 0;
  3800. LoadFromStream(fs);
  3801. finally
  3802. fs.Free;
  3803. end;
  3804. end;
  3805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3806. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3807. begin
  3808. {$IFDEF GLB_SUPPORT_PNG_READ}
  3809. if not LoadPNG(aStream) then
  3810. {$ENDIF}
  3811. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3812. if not LoadJPEG(aStream) then
  3813. {$ENDIF}
  3814. if not LoadDDS(aStream) then
  3815. if not LoadTGA(aStream) then
  3816. if not LoadBMP(aStream) then
  3817. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3818. end;
  3819. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3820. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3821. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3822. var
  3823. tmpData: PByte;
  3824. size: Integer;
  3825. begin
  3826. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3827. GetMem(tmpData, size);
  3828. try
  3829. FillChar(tmpData^, size, #$FF);
  3830. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  3831. except
  3832. if Assigned(tmpData) then
  3833. FreeMem(tmpData);
  3834. raise;
  3835. end;
  3836. AddFunc(Self, aFunc, false, Format, aArgs);
  3837. end;
  3838. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3839. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  3840. var
  3841. rs: TResourceStream;
  3842. begin
  3843. PrepareResType(aResource, aResType);
  3844. rs := TResourceStream.Create(aInstance, aResource, aResType);
  3845. try
  3846. LoadFromStream(rs);
  3847. finally
  3848. rs.Free;
  3849. end;
  3850. end;
  3851. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3852. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3853. var
  3854. rs: TResourceStream;
  3855. begin
  3856. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  3857. try
  3858. LoadFromStream(rs);
  3859. finally
  3860. rs.Free;
  3861. end;
  3862. end;
  3863. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3864. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3865. var
  3866. fs: TFileStream;
  3867. begin
  3868. fs := TFileStream.Create(aFileName, fmCreate);
  3869. try
  3870. fs.Position := 0;
  3871. SaveToStream(fs, aFileType);
  3872. finally
  3873. fs.Free;
  3874. end;
  3875. end;
  3876. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3877. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3878. begin
  3879. case aFileType of
  3880. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3881. ftPNG: SavePNG(aStream);
  3882. {$ENDIF}
  3883. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3884. ftJPEG: SaveJPEG(aStream);
  3885. {$ENDIF}
  3886. ftDDS: SaveDDS(aStream);
  3887. ftTGA: SaveTGA(aStream);
  3888. ftBMP: SaveBMP(aStream);
  3889. end;
  3890. end;
  3891. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3892. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3893. begin
  3894. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3895. end;
  3896. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3897. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3898. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3899. var
  3900. DestData, TmpData, SourceData: pByte;
  3901. TempHeight, TempWidth: Integer;
  3902. SourceFD, DestFD: TFormatDescriptor;
  3903. SourceMD, DestMD: Pointer;
  3904. FuncRec: TglBitmapFunctionRec;
  3905. begin
  3906. Assert(Assigned(Data));
  3907. Assert(Assigned(aSource));
  3908. Assert(Assigned(aSource.Data));
  3909. result := false;
  3910. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3911. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3912. DestFD := TFormatDescriptor.Get(aFormat);
  3913. if (SourceFD.IsCompressed) then
  3914. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  3915. if (DestFD.IsCompressed) then
  3916. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  3917. // inkompatible Formats so CreateTemp
  3918. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3919. aCreateTemp := true;
  3920. // Values
  3921. TempHeight := Max(1, aSource.Height);
  3922. TempWidth := Max(1, aSource.Width);
  3923. FuncRec.Sender := Self;
  3924. FuncRec.Args := aArgs;
  3925. TmpData := nil;
  3926. if aCreateTemp then begin
  3927. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  3928. DestData := TmpData;
  3929. end else
  3930. DestData := Data;
  3931. try
  3932. SourceFD.PreparePixel(FuncRec.Source);
  3933. DestFD.PreparePixel (FuncRec.Dest);
  3934. SourceMD := SourceFD.CreateMappingData;
  3935. DestMD := DestFD.CreateMappingData;
  3936. FuncRec.Size := aSource.Dimension;
  3937. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3938. try
  3939. SourceData := aSource.Data;
  3940. FuncRec.Position.Y := 0;
  3941. while FuncRec.Position.Y < TempHeight do begin
  3942. FuncRec.Position.X := 0;
  3943. while FuncRec.Position.X < TempWidth do begin
  3944. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3945. aFunc(FuncRec);
  3946. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3947. inc(FuncRec.Position.X);
  3948. end;
  3949. inc(FuncRec.Position.Y);
  3950. end;
  3951. // Updating Image or InternalFormat
  3952. if aCreateTemp then
  3953. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  3954. else if (aFormat <> fFormat) then
  3955. Format := aFormat;
  3956. result := true;
  3957. finally
  3958. SourceFD.FreeMappingData(SourceMD);
  3959. DestFD.FreeMappingData(DestMD);
  3960. end;
  3961. except
  3962. if aCreateTemp and Assigned(TmpData) then
  3963. FreeMem(TmpData);
  3964. raise;
  3965. end;
  3966. end;
  3967. end;
  3968. {$IFDEF GLB_SDL}
  3969. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3970. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  3971. var
  3972. Row, RowSize: Integer;
  3973. SourceData, TmpData: PByte;
  3974. TempDepth: Integer;
  3975. FormatDesc: TFormatDescriptor;
  3976. function GetRowPointer(Row: Integer): pByte;
  3977. begin
  3978. result := aSurface.pixels;
  3979. Inc(result, Row * RowSize);
  3980. end;
  3981. begin
  3982. result := false;
  3983. FormatDesc := TFormatDescriptor.Get(Format);
  3984. if FormatDesc.IsCompressed then
  3985. raise EglBitmapUnsupportedFormat.Create(Format);
  3986. if Assigned(Data) then begin
  3987. case Trunc(FormatDesc.PixelSize) of
  3988. 1: TempDepth := 8;
  3989. 2: TempDepth := 16;
  3990. 3: TempDepth := 24;
  3991. 4: TempDepth := 32;
  3992. else
  3993. raise EglBitmapUnsupportedFormat.Create(Format);
  3994. end;
  3995. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  3996. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  3997. SourceData := Data;
  3998. RowSize := FormatDesc.GetSize(FileWidth, 1);
  3999. for Row := 0 to FileHeight-1 do begin
  4000. TmpData := GetRowPointer(Row);
  4001. if Assigned(TmpData) then begin
  4002. Move(SourceData^, TmpData^, RowSize);
  4003. inc(SourceData, RowSize);
  4004. end;
  4005. end;
  4006. result := true;
  4007. end;
  4008. end;
  4009. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4010. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4011. var
  4012. pSource, pData, pTempData: PByte;
  4013. Row, RowSize, TempWidth, TempHeight: Integer;
  4014. IntFormat: TglBitmapFormat;
  4015. FormatDesc: TFormatDescriptor;
  4016. function GetRowPointer(Row: Integer): pByte;
  4017. begin
  4018. result := aSurface^.pixels;
  4019. Inc(result, Row * RowSize);
  4020. end;
  4021. begin
  4022. result := false;
  4023. if (Assigned(aSurface)) then begin
  4024. with aSurface^.format^ do begin
  4025. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  4026. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4027. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  4028. break;
  4029. end;
  4030. if (IntFormat = tfEmpty) then
  4031. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  4032. end;
  4033. TempWidth := aSurface^.w;
  4034. TempHeight := aSurface^.h;
  4035. RowSize := FormatDesc.GetSize(TempWidth, 1);
  4036. GetMem(pData, TempHeight * RowSize);
  4037. try
  4038. pTempData := pData;
  4039. for Row := 0 to TempHeight -1 do begin
  4040. pSource := GetRowPointer(Row);
  4041. if (Assigned(pSource)) then begin
  4042. Move(pSource^, pTempData^, RowSize);
  4043. Inc(pTempData, RowSize);
  4044. end;
  4045. end;
  4046. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4047. result := true;
  4048. except
  4049. if Assigned(pData) then
  4050. FreeMem(pData);
  4051. raise;
  4052. end;
  4053. end;
  4054. end;
  4055. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4056. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4057. var
  4058. Row, Col, AlphaInterleave: Integer;
  4059. pSource, pDest: PByte;
  4060. function GetRowPointer(Row: Integer): pByte;
  4061. begin
  4062. result := aSurface.pixels;
  4063. Inc(result, Row * Width);
  4064. end;
  4065. begin
  4066. result := false;
  4067. if Assigned(Data) then begin
  4068. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  4069. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4070. AlphaInterleave := 0;
  4071. case Format of
  4072. tfLuminance8Alpha8:
  4073. AlphaInterleave := 1;
  4074. tfBGRA8, tfRGBA8:
  4075. AlphaInterleave := 3;
  4076. end;
  4077. pSource := Data;
  4078. for Row := 0 to Height -1 do begin
  4079. pDest := GetRowPointer(Row);
  4080. if Assigned(pDest) then begin
  4081. for Col := 0 to Width -1 do begin
  4082. Inc(pSource, AlphaInterleave);
  4083. pDest^ := pSource^;
  4084. Inc(pDest);
  4085. Inc(pSource);
  4086. end;
  4087. end;
  4088. end;
  4089. result := true;
  4090. end;
  4091. end;
  4092. end;
  4093. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4094. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4095. var
  4096. bmp: TglBitmap2D;
  4097. begin
  4098. bmp := TglBitmap2D.Create;
  4099. try
  4100. bmp.AssignFromSurface(aSurface);
  4101. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4102. finally
  4103. bmp.Free;
  4104. end;
  4105. end;
  4106. {$ENDIF}
  4107. {$IFDEF GLB_DELPHI}
  4108. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4109. function CreateGrayPalette: HPALETTE;
  4110. var
  4111. Idx: Integer;
  4112. Pal: PLogPalette;
  4113. begin
  4114. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4115. Pal.palVersion := $300;
  4116. Pal.palNumEntries := 256;
  4117. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4118. Pal.palPalEntry[Idx].peRed := Idx;
  4119. Pal.palPalEntry[Idx].peGreen := Idx;
  4120. Pal.palPalEntry[Idx].peBlue := Idx;
  4121. Pal.palPalEntry[Idx].peFlags := 0;
  4122. end;
  4123. Result := CreatePalette(Pal^);
  4124. FreeMem(Pal);
  4125. end;
  4126. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4127. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4128. var
  4129. Row: Integer;
  4130. pSource, pData: PByte;
  4131. begin
  4132. result := false;
  4133. if Assigned(Data) then begin
  4134. if Assigned(aBitmap) then begin
  4135. aBitmap.Width := Width;
  4136. aBitmap.Height := Height;
  4137. case Format of
  4138. tfAlpha8, tfLuminance8: begin
  4139. aBitmap.PixelFormat := pf8bit;
  4140. aBitmap.Palette := CreateGrayPalette;
  4141. end;
  4142. tfRGB5A1:
  4143. aBitmap.PixelFormat := pf15bit;
  4144. tfR5G6B5:
  4145. aBitmap.PixelFormat := pf16bit;
  4146. tfRGB8, tfBGR8:
  4147. aBitmap.PixelFormat := pf24bit;
  4148. tfRGBA8, tfBGRA8:
  4149. aBitmap.PixelFormat := pf32bit;
  4150. else
  4151. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4152. end;
  4153. pSource := Data;
  4154. for Row := 0 to FileHeight -1 do begin
  4155. pData := aBitmap.Scanline[Row];
  4156. Move(pSource^, pData^, fRowSize);
  4157. Inc(pSource, fRowSize);
  4158. if (Format in [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A)
  4159. SwapRGB(pData, FileWidth, Format = tfRGBA8);
  4160. end;
  4161. result := true;
  4162. end;
  4163. end;
  4164. end;
  4165. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4166. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4167. var
  4168. pSource, pData, pTempData: PByte;
  4169. Row, RowSize, TempWidth, TempHeight: Integer;
  4170. IntFormat: TglBitmapFormat;
  4171. begin
  4172. result := false;
  4173. if (Assigned(aBitmap)) then begin
  4174. case aBitmap.PixelFormat of
  4175. pf8bit:
  4176. IntFormat := tfLuminance8;
  4177. pf15bit:
  4178. IntFormat := tfRGB5A1;
  4179. pf16bit:
  4180. IntFormat := tfR5G6B5;
  4181. pf24bit:
  4182. IntFormat := tfBGR8;
  4183. pf32bit:
  4184. IntFormat := tfBGRA8;
  4185. else
  4186. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4187. end;
  4188. TempWidth := aBitmap.Width;
  4189. TempHeight := aBitmap.Height;
  4190. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4191. GetMem(pData, TempHeight * RowSize);
  4192. try
  4193. pTempData := pData;
  4194. for Row := 0 to TempHeight -1 do begin
  4195. pSource := aBitmap.Scanline[Row];
  4196. if (Assigned(pSource)) then begin
  4197. Move(pSource^, pTempData^, RowSize);
  4198. Inc(pTempData, RowSize);
  4199. end;
  4200. end;
  4201. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4202. result := true;
  4203. except
  4204. if Assigned(pData) then
  4205. FreeMem(pData);
  4206. raise;
  4207. end;
  4208. end;
  4209. end;
  4210. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4211. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4212. var
  4213. Row, Col, AlphaInterleave: Integer;
  4214. pSource, pDest: PByte;
  4215. begin
  4216. result := false;
  4217. if Assigned(Data) then begin
  4218. if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
  4219. if Assigned(aBitmap) then begin
  4220. aBitmap.PixelFormat := pf8bit;
  4221. aBitmap.Palette := CreateGrayPalette;
  4222. aBitmap.Width := Width;
  4223. aBitmap.Height := Height;
  4224. case Format of
  4225. tfLuminance8Alpha8:
  4226. AlphaInterleave := 1;
  4227. tfRGBA8, tfBGRA8:
  4228. AlphaInterleave := 3;
  4229. else
  4230. AlphaInterleave := 0;
  4231. end;
  4232. // Copy Data
  4233. pSource := Data;
  4234. for Row := 0 to Height -1 do begin
  4235. pDest := aBitmap.Scanline[Row];
  4236. if Assigned(pDest) then begin
  4237. for Col := 0 to Width -1 do begin
  4238. Inc(pSource, AlphaInterleave);
  4239. pDest^ := pSource^;
  4240. Inc(pDest);
  4241. Inc(pSource);
  4242. end;
  4243. end;
  4244. end;
  4245. result := true;
  4246. end;
  4247. end;
  4248. end;
  4249. end;
  4250. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4251. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4252. var
  4253. tex: TglBitmap2D;
  4254. begin
  4255. tex := TglBitmap2D.Create;
  4256. try
  4257. tex.AssignFromBitmap(ABitmap);
  4258. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4259. finally
  4260. tex.Free;
  4261. end;
  4262. end;
  4263. {$ENDIF}
  4264. {$IFDEF GLB_LAZARUS}
  4265. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4266. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4267. var
  4268. rid: TRawImageDescription;
  4269. FormatDesc: TFormatDescriptor;
  4270. begin
  4271. result := false;
  4272. if not Assigned(aImage) or (Format = tfEmpty) then
  4273. exit;
  4274. FormatDesc := TFormatDescriptor.Get(Format);
  4275. if FormatDesc.IsCompressed then
  4276. exit;
  4277. FillChar(rid{%H-}, SizeOf(rid), 0);
  4278. if (Format in [
  4279. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  4280. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  4281. tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
  4282. rid.Format := ricfGray
  4283. else
  4284. rid.Format := ricfRGBA;
  4285. rid.Width := Width;
  4286. rid.Height := Height;
  4287. rid.Depth := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
  4288. rid.BitOrder := riboBitsInOrder;
  4289. rid.ByteOrder := riboLSBFirst;
  4290. rid.LineOrder := riloTopToBottom;
  4291. rid.LineEnd := rileTight;
  4292. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4293. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4294. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4295. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4296. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4297. rid.RedShift := FormatDesc.Shift.r;
  4298. rid.GreenShift := FormatDesc.Shift.g;
  4299. rid.BlueShift := FormatDesc.Shift.b;
  4300. rid.AlphaShift := FormatDesc.Shift.a;
  4301. rid.MaskBitsPerPixel := 0;
  4302. rid.PaletteColorCount := 0;
  4303. aImage.DataDescription := rid;
  4304. aImage.CreateData;
  4305. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4306. result := true;
  4307. end;
  4308. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4309. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4310. var
  4311. f: TglBitmapFormat;
  4312. FormatDesc: TFormatDescriptor;
  4313. ImageData: PByte;
  4314. ImageSize: Integer;
  4315. begin
  4316. result := false;
  4317. if not Assigned(aImage) then
  4318. exit;
  4319. for f := High(f) downto Low(f) do begin
  4320. FormatDesc := TFormatDescriptor.Get(f);
  4321. with aImage.DataDescription do
  4322. if FormatDesc.MaskMatch(
  4323. (QWord(1 shl RedPrec )-1) shl RedShift,
  4324. (QWord(1 shl GreenPrec)-1) shl GreenShift,
  4325. (QWord(1 shl BluePrec )-1) shl BlueShift,
  4326. (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
  4327. break;
  4328. end;
  4329. if (f = tfEmpty) then
  4330. exit;
  4331. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4332. ImageData := GetMem(ImageSize);
  4333. try
  4334. Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
  4335. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4336. except
  4337. if Assigned(ImageData) then
  4338. FreeMem(ImageData);
  4339. raise;
  4340. end;
  4341. result := true;
  4342. end;
  4343. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4344. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4345. var
  4346. rid: TRawImageDescription;
  4347. FormatDesc: TFormatDescriptor;
  4348. Pixel: TglBitmapPixelData;
  4349. x, y: Integer;
  4350. srcMD: Pointer;
  4351. src, dst: PByte;
  4352. begin
  4353. result := false;
  4354. if not Assigned(aImage) or (Format = tfEmpty) then
  4355. exit;
  4356. FormatDesc := TFormatDescriptor.Get(Format);
  4357. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4358. exit;
  4359. FillChar(rid{%H-}, SizeOf(rid), 0);
  4360. rid.Format := ricfGray;
  4361. rid.Width := Width;
  4362. rid.Height := Height;
  4363. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4364. rid.BitOrder := riboBitsInOrder;
  4365. rid.ByteOrder := riboLSBFirst;
  4366. rid.LineOrder := riloTopToBottom;
  4367. rid.LineEnd := rileTight;
  4368. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4369. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4370. rid.GreenPrec := 0;
  4371. rid.BluePrec := 0;
  4372. rid.AlphaPrec := 0;
  4373. rid.RedShift := 0;
  4374. rid.GreenShift := 0;
  4375. rid.BlueShift := 0;
  4376. rid.AlphaShift := 0;
  4377. rid.MaskBitsPerPixel := 0;
  4378. rid.PaletteColorCount := 0;
  4379. aImage.DataDescription := rid;
  4380. aImage.CreateData;
  4381. srcMD := FormatDesc.CreateMappingData;
  4382. try
  4383. FormatDesc.PreparePixel(Pixel);
  4384. src := Data;
  4385. dst := aImage.PixelData;
  4386. for y := 0 to Height-1 do
  4387. for x := 0 to Width-1 do begin
  4388. FormatDesc.Unmap(src, Pixel, srcMD);
  4389. case rid.BitsPerPixel of
  4390. 8: begin
  4391. dst^ := Pixel.Data.a;
  4392. inc(dst);
  4393. end;
  4394. 16: begin
  4395. PWord(dst)^ := Pixel.Data.a;
  4396. inc(dst, 2);
  4397. end;
  4398. 24: begin
  4399. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4400. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4401. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4402. inc(dst, 3);
  4403. end;
  4404. 32: begin
  4405. PCardinal(dst)^ := Pixel.Data.a;
  4406. inc(dst, 4);
  4407. end;
  4408. else
  4409. raise EglBitmapUnsupportedFormat.Create(Format);
  4410. end;
  4411. end;
  4412. finally
  4413. FormatDesc.FreeMappingData(srcMD);
  4414. end;
  4415. result := true;
  4416. end;
  4417. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4418. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4419. var
  4420. tex: TglBitmap2D;
  4421. begin
  4422. tex := TglBitmap2D.Create;
  4423. try
  4424. tex.AssignFromLazIntfImage(aImage);
  4425. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4426. finally
  4427. tex.Free;
  4428. end;
  4429. end;
  4430. {$ENDIF}
  4431. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4432. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4433. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4434. var
  4435. rs: TResourceStream;
  4436. begin
  4437. PrepareResType(aResource, aResType);
  4438. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4439. try
  4440. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4441. finally
  4442. rs.Free;
  4443. end;
  4444. end;
  4445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4446. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4447. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4448. var
  4449. rs: TResourceStream;
  4450. begin
  4451. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4452. try
  4453. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4454. finally
  4455. rs.Free;
  4456. end;
  4457. end;
  4458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4459. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4460. begin
  4461. if TFormatDescriptor.Get(Format).IsCompressed then
  4462. raise EglBitmapUnsupportedFormat.Create(Format);
  4463. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4464. end;
  4465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4466. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4467. var
  4468. FS: TFileStream;
  4469. begin
  4470. FS := TFileStream.Create(aFileName, fmOpenRead);
  4471. try
  4472. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4473. finally
  4474. FS.Free;
  4475. end;
  4476. end;
  4477. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4478. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4479. var
  4480. tex: TglBitmap2D;
  4481. begin
  4482. tex := TglBitmap2D.Create(aStream);
  4483. try
  4484. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4485. finally
  4486. tex.Free;
  4487. end;
  4488. end;
  4489. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4490. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4491. var
  4492. DestData, DestData2, SourceData: pByte;
  4493. TempHeight, TempWidth: Integer;
  4494. SourceFD, DestFD: TFormatDescriptor;
  4495. SourceMD, DestMD, DestMD2: Pointer;
  4496. FuncRec: TglBitmapFunctionRec;
  4497. begin
  4498. result := false;
  4499. Assert(Assigned(Data));
  4500. Assert(Assigned(aBitmap));
  4501. Assert(Assigned(aBitmap.Data));
  4502. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4503. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4504. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4505. DestFD := TFormatDescriptor.Get(Format);
  4506. if not Assigned(aFunc) then begin
  4507. aFunc := glBitmapAlphaFunc;
  4508. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4509. end else
  4510. FuncRec.Args := aArgs;
  4511. // Values
  4512. TempHeight := aBitmap.FileHeight;
  4513. TempWidth := aBitmap.FileWidth;
  4514. FuncRec.Sender := Self;
  4515. FuncRec.Size := Dimension;
  4516. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4517. DestData := Data;
  4518. DestData2 := Data;
  4519. SourceData := aBitmap.Data;
  4520. // Mapping
  4521. SourceFD.PreparePixel(FuncRec.Source);
  4522. DestFD.PreparePixel (FuncRec.Dest);
  4523. SourceMD := SourceFD.CreateMappingData;
  4524. DestMD := DestFD.CreateMappingData;
  4525. DestMD2 := DestFD.CreateMappingData;
  4526. try
  4527. FuncRec.Position.Y := 0;
  4528. while FuncRec.Position.Y < TempHeight do begin
  4529. FuncRec.Position.X := 0;
  4530. while FuncRec.Position.X < TempWidth do begin
  4531. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4532. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4533. aFunc(FuncRec);
  4534. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4535. inc(FuncRec.Position.X);
  4536. end;
  4537. inc(FuncRec.Position.Y);
  4538. end;
  4539. finally
  4540. SourceFD.FreeMappingData(SourceMD);
  4541. DestFD.FreeMappingData(DestMD);
  4542. DestFD.FreeMappingData(DestMD2);
  4543. end;
  4544. end;
  4545. end;
  4546. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4547. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4548. begin
  4549. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4550. end;
  4551. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4552. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4553. var
  4554. PixelData: TglBitmapPixelData;
  4555. begin
  4556. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4557. result := AddAlphaFromColorKeyFloat(
  4558. aRed / PixelData.Range.r,
  4559. aGreen / PixelData.Range.g,
  4560. aBlue / PixelData.Range.b,
  4561. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4562. end;
  4563. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4564. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4565. var
  4566. values: array[0..2] of Single;
  4567. tmp: Cardinal;
  4568. i: Integer;
  4569. PixelData: TglBitmapPixelData;
  4570. begin
  4571. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4572. with PixelData do begin
  4573. values[0] := aRed;
  4574. values[1] := aGreen;
  4575. values[2] := aBlue;
  4576. for i := 0 to 2 do begin
  4577. tmp := Trunc(Range.arr[i] * aDeviation);
  4578. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4579. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4580. end;
  4581. Data.a := 0;
  4582. Range.a := 0;
  4583. end;
  4584. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4585. end;
  4586. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4587. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4588. begin
  4589. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4590. end;
  4591. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4592. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4593. var
  4594. PixelData: TglBitmapPixelData;
  4595. begin
  4596. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4597. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4598. end;
  4599. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4600. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4601. var
  4602. PixelData: TglBitmapPixelData;
  4603. begin
  4604. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4605. with PixelData do
  4606. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4607. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4608. end;
  4609. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4610. function TglBitmap.RemoveAlpha: Boolean;
  4611. var
  4612. FormatDesc: TFormatDescriptor;
  4613. begin
  4614. result := false;
  4615. FormatDesc := TFormatDescriptor.Get(Format);
  4616. if Assigned(Data) then begin
  4617. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4618. raise EglBitmapUnsupportedFormat.Create(Format);
  4619. result := ConvertTo(FormatDesc.WithoutAlpha);
  4620. end;
  4621. end;
  4622. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4623. function TglBitmap.Clone: TglBitmap;
  4624. var
  4625. Temp: TglBitmap;
  4626. TempPtr: PByte;
  4627. Size: Integer;
  4628. begin
  4629. result := nil;
  4630. Temp := (ClassType.Create as TglBitmap);
  4631. try
  4632. // copy texture data if assigned
  4633. if Assigned(Data) then begin
  4634. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4635. GetMem(TempPtr, Size);
  4636. try
  4637. Move(Data^, TempPtr^, Size);
  4638. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4639. except
  4640. if Assigned(TempPtr) then
  4641. FreeMem(TempPtr);
  4642. raise;
  4643. end;
  4644. end else begin
  4645. TempPtr := nil;
  4646. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4647. end;
  4648. // copy properties
  4649. Temp.fID := ID;
  4650. Temp.fTarget := Target;
  4651. Temp.fFormat := Format;
  4652. Temp.fMipMap := MipMap;
  4653. Temp.fAnisotropic := Anisotropic;
  4654. Temp.fBorderColor := fBorderColor;
  4655. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4656. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4657. Temp.fFilterMin := fFilterMin;
  4658. Temp.fFilterMag := fFilterMag;
  4659. Temp.fWrapS := fWrapS;
  4660. Temp.fWrapT := fWrapT;
  4661. Temp.fWrapR := fWrapR;
  4662. Temp.fFilename := fFilename;
  4663. Temp.fCustomName := fCustomName;
  4664. Temp.fCustomNameW := fCustomNameW;
  4665. Temp.fCustomData := fCustomData;
  4666. result := Temp;
  4667. except
  4668. FreeAndNil(Temp);
  4669. raise;
  4670. end;
  4671. end;
  4672. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4673. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4674. var
  4675. SourceFD, DestFD: TFormatDescriptor;
  4676. SourcePD, DestPD: TglBitmapPixelData;
  4677. ShiftData: TShiftData;
  4678. function CanCopyDirect: Boolean;
  4679. begin
  4680. result :=
  4681. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4682. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4683. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4684. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4685. end;
  4686. function CanShift: Boolean;
  4687. begin
  4688. result :=
  4689. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4690. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4691. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4692. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4693. end;
  4694. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4695. begin
  4696. result := 0;
  4697. while (aSource > aDest) and (aSource > 0) do begin
  4698. inc(result);
  4699. aSource := aSource shr 1;
  4700. end;
  4701. end;
  4702. begin
  4703. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4704. SourceFD := TFormatDescriptor.Get(Format);
  4705. DestFD := TFormatDescriptor.Get(aFormat);
  4706. SourceFD.PreparePixel(SourcePD);
  4707. DestFD.PreparePixel (DestPD);
  4708. if CanCopyDirect then
  4709. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4710. else if CanShift then begin
  4711. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4712. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4713. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4714. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4715. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4716. end else
  4717. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4718. end else
  4719. result := true;
  4720. end;
  4721. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4722. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4723. begin
  4724. if aUseRGB or aUseAlpha then
  4725. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4726. ((Byte(aUseAlpha) and 1) shl 1) or
  4727. (Byte(aUseRGB) and 1) ));
  4728. end;
  4729. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4730. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4731. begin
  4732. fBorderColor[0] := aRed;
  4733. fBorderColor[1] := aGreen;
  4734. fBorderColor[2] := aBlue;
  4735. fBorderColor[3] := aAlpha;
  4736. if (ID > 0) then begin
  4737. Bind(false);
  4738. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4739. end;
  4740. end;
  4741. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4742. procedure TglBitmap.FreeData;
  4743. var
  4744. TempPtr: PByte;
  4745. begin
  4746. TempPtr := nil;
  4747. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  4748. end;
  4749. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4750. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4751. const aAlpha: Byte);
  4752. begin
  4753. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4754. end;
  4755. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4756. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4757. var
  4758. PixelData: TglBitmapPixelData;
  4759. begin
  4760. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4761. FillWithColorFloat(
  4762. aRed / PixelData.Range.r,
  4763. aGreen / PixelData.Range.g,
  4764. aBlue / PixelData.Range.b,
  4765. aAlpha / PixelData.Range.a);
  4766. end;
  4767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4768. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4769. var
  4770. PixelData: TglBitmapPixelData;
  4771. begin
  4772. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4773. with PixelData do begin
  4774. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4775. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4776. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4777. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4778. end;
  4779. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4780. end;
  4781. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4782. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  4783. begin
  4784. //check MIN filter
  4785. case aMin of
  4786. GL_NEAREST:
  4787. fFilterMin := GL_NEAREST;
  4788. GL_LINEAR:
  4789. fFilterMin := GL_LINEAR;
  4790. GL_NEAREST_MIPMAP_NEAREST:
  4791. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4792. GL_LINEAR_MIPMAP_NEAREST:
  4793. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4794. GL_NEAREST_MIPMAP_LINEAR:
  4795. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4796. GL_LINEAR_MIPMAP_LINEAR:
  4797. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4798. else
  4799. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  4800. end;
  4801. //check MAG filter
  4802. case aMag of
  4803. GL_NEAREST:
  4804. fFilterMag := GL_NEAREST;
  4805. GL_LINEAR:
  4806. fFilterMag := GL_LINEAR;
  4807. else
  4808. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  4809. end;
  4810. //apply filter
  4811. if (ID > 0) then begin
  4812. Bind(false);
  4813. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4814. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4815. case fFilterMin of
  4816. GL_NEAREST, GL_LINEAR:
  4817. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4818. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4819. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4820. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4821. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4822. end;
  4823. end else
  4824. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4825. end;
  4826. end;
  4827. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4828. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  4829. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4830. begin
  4831. case aValue of
  4832. GL_CLAMP:
  4833. aTarget := GL_CLAMP;
  4834. GL_REPEAT:
  4835. aTarget := GL_REPEAT;
  4836. GL_CLAMP_TO_EDGE: begin
  4837. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4838. aTarget := GL_CLAMP_TO_EDGE
  4839. else
  4840. aTarget := GL_CLAMP;
  4841. end;
  4842. GL_CLAMP_TO_BORDER: begin
  4843. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4844. aTarget := GL_CLAMP_TO_BORDER
  4845. else
  4846. aTarget := GL_CLAMP;
  4847. end;
  4848. GL_MIRRORED_REPEAT: begin
  4849. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4850. aTarget := GL_MIRRORED_REPEAT
  4851. else
  4852. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4853. end;
  4854. else
  4855. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  4856. end;
  4857. end;
  4858. begin
  4859. CheckAndSetWrap(S, fWrapS);
  4860. CheckAndSetWrap(T, fWrapT);
  4861. CheckAndSetWrap(R, fWrapR);
  4862. if (ID > 0) then begin
  4863. Bind(false);
  4864. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4865. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4866. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4867. end;
  4868. end;
  4869. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4870. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  4871. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  4872. begin
  4873. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  4874. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  4875. fSwizzle[aIndex] := aValue
  4876. else
  4877. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  4878. end;
  4879. begin
  4880. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4881. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  4882. CheckAndSetValue(r, 0);
  4883. CheckAndSetValue(g, 1);
  4884. CheckAndSetValue(b, 2);
  4885. CheckAndSetValue(a, 3);
  4886. if (ID > 0) then begin
  4887. Bind(false);
  4888. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
  4889. end;
  4890. end;
  4891. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4892. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4893. begin
  4894. if aEnableTextureUnit then
  4895. glEnable(Target);
  4896. if (ID > 0) then
  4897. glBindTexture(Target, ID);
  4898. end;
  4899. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4900. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4901. begin
  4902. if aDisableTextureUnit then
  4903. glDisable(Target);
  4904. glBindTexture(Target, 0);
  4905. end;
  4906. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4907. constructor TglBitmap.Create;
  4908. begin
  4909. if (ClassType = TglBitmap) then
  4910. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4911. {$IFDEF GLB_NATIVE_OGL}
  4912. glbReadOpenGLExtensions;
  4913. {$ENDIF}
  4914. inherited Create;
  4915. end;
  4916. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4917. constructor TglBitmap.Create(const aFileName: String);
  4918. begin
  4919. Create;
  4920. LoadFromFile(aFileName);
  4921. end;
  4922. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4923. constructor TglBitmap.Create(const aStream: TStream);
  4924. begin
  4925. Create;
  4926. LoadFromStream(aStream);
  4927. end;
  4928. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4929. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
  4930. var
  4931. Image: PByte;
  4932. ImageSize: Integer;
  4933. begin
  4934. Create;
  4935. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4936. GetMem(Image, ImageSize);
  4937. try
  4938. FillChar(Image^, ImageSize, #$FF);
  4939. SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4940. except
  4941. if Assigned(Image) then
  4942. FreeMem(Image);
  4943. raise;
  4944. end;
  4945. end;
  4946. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4947. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
  4948. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  4949. begin
  4950. Create;
  4951. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  4952. end;
  4953. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4954. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  4955. begin
  4956. Create;
  4957. LoadFromResource(aInstance, aResource, aResType);
  4958. end;
  4959. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4960. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4961. begin
  4962. Create;
  4963. LoadFromResourceID(aInstance, aResourceID, aResType);
  4964. end;
  4965. {$IFDEF GLB_SUPPORT_PNG_READ}
  4966. {$IF DEFINED(GLB_LAZ_PNG)}
  4967. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4968. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4969. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4970. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4971. const
  4972. MAGIC_LEN = 8;
  4973. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  4974. var
  4975. png: TPortableNetworkGraphic;
  4976. intf: TLazIntfImage;
  4977. StreamPos: Int64;
  4978. magic: String[MAGIC_LEN];
  4979. begin
  4980. result := true;
  4981. StreamPos := aStream.Position;
  4982. SetLength(magic, MAGIC_LEN);
  4983. aStream.Read(magic[1], MAGIC_LEN);
  4984. aStream.Position := StreamPos;
  4985. if (magic <> PNG_MAGIC) then begin
  4986. result := false;
  4987. exit;
  4988. end;
  4989. png := TPortableNetworkGraphic.Create;
  4990. try try
  4991. png.LoadFromStream(aStream);
  4992. intf := png.CreateIntfImage;
  4993. try try
  4994. AssignFromLazIntfImage(intf);
  4995. except
  4996. result := false;
  4997. aStream.Position := StreamPos;
  4998. exit;
  4999. end;
  5000. finally
  5001. intf.Free;
  5002. end;
  5003. except
  5004. result := false;
  5005. aStream.Position := StreamPos;
  5006. exit;
  5007. end;
  5008. finally
  5009. png.Free;
  5010. end;
  5011. end;
  5012. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5013. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5014. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5015. var
  5016. Surface: PSDL_Surface;
  5017. RWops: PSDL_RWops;
  5018. begin
  5019. result := false;
  5020. RWops := glBitmapCreateRWops(aStream);
  5021. try
  5022. if IMG_isPNG(RWops) > 0 then begin
  5023. Surface := IMG_LoadPNG_RW(RWops);
  5024. try
  5025. AssignFromSurface(Surface);
  5026. result := true;
  5027. finally
  5028. SDL_FreeSurface(Surface);
  5029. end;
  5030. end;
  5031. finally
  5032. SDL_FreeRW(RWops);
  5033. end;
  5034. end;
  5035. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5036. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5037. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5038. begin
  5039. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5040. end;
  5041. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5042. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5043. var
  5044. StreamPos: Int64;
  5045. signature: array [0..7] of byte;
  5046. png: png_structp;
  5047. png_info: png_infop;
  5048. TempHeight, TempWidth: Integer;
  5049. Format: TglBitmapFormat;
  5050. png_data: pByte;
  5051. png_rows: array of pByte;
  5052. Row, LineSize: Integer;
  5053. begin
  5054. result := false;
  5055. if not init_libPNG then
  5056. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5057. try
  5058. // signature
  5059. StreamPos := aStream.Position;
  5060. aStream.Read(signature{%H-}, 8);
  5061. aStream.Position := StreamPos;
  5062. if png_check_sig(@signature, 8) <> 0 then begin
  5063. // png read struct
  5064. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5065. if png = nil then
  5066. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5067. // png info
  5068. png_info := png_create_info_struct(png);
  5069. if png_info = nil then begin
  5070. png_destroy_read_struct(@png, nil, nil);
  5071. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5072. end;
  5073. // set read callback
  5074. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5075. // read informations
  5076. png_read_info(png, png_info);
  5077. // size
  5078. TempHeight := png_get_image_height(png, png_info);
  5079. TempWidth := png_get_image_width(png, png_info);
  5080. // format
  5081. case png_get_color_type(png, png_info) of
  5082. PNG_COLOR_TYPE_GRAY:
  5083. Format := tfLuminance8;
  5084. PNG_COLOR_TYPE_GRAY_ALPHA:
  5085. Format := tfLuminance8Alpha8;
  5086. PNG_COLOR_TYPE_RGB:
  5087. Format := tfRGB8;
  5088. PNG_COLOR_TYPE_RGB_ALPHA:
  5089. Format := tfRGBA8;
  5090. else
  5091. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5092. end;
  5093. // cut upper 8 bit from 16 bit formats
  5094. if png_get_bit_depth(png, png_info) > 8 then
  5095. png_set_strip_16(png);
  5096. // expand bitdepth smaller than 8
  5097. if png_get_bit_depth(png, png_info) < 8 then
  5098. png_set_expand(png);
  5099. // allocating mem for scanlines
  5100. LineSize := png_get_rowbytes(png, png_info);
  5101. GetMem(png_data, TempHeight * LineSize);
  5102. try
  5103. SetLength(png_rows, TempHeight);
  5104. for Row := Low(png_rows) to High(png_rows) do begin
  5105. png_rows[Row] := png_data;
  5106. Inc(png_rows[Row], Row * LineSize);
  5107. end;
  5108. // read complete image into scanlines
  5109. png_read_image(png, @png_rows[0]);
  5110. // read end
  5111. png_read_end(png, png_info);
  5112. // destroy read struct
  5113. png_destroy_read_struct(@png, @png_info, nil);
  5114. SetLength(png_rows, 0);
  5115. // set new data
  5116. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5117. result := true;
  5118. except
  5119. if Assigned(png_data) then
  5120. FreeMem(png_data);
  5121. raise;
  5122. end;
  5123. end;
  5124. finally
  5125. quit_libPNG;
  5126. end;
  5127. end;
  5128. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5129. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5130. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5131. var
  5132. StreamPos: Int64;
  5133. Png: TPNGObject;
  5134. Header: String[8];
  5135. Row, Col, PixSize, LineSize: Integer;
  5136. NewImage, pSource, pDest, pAlpha: pByte;
  5137. PngFormat: TglBitmapFormat;
  5138. FormatDesc: TFormatDescriptor;
  5139. const
  5140. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5141. begin
  5142. result := false;
  5143. StreamPos := aStream.Position;
  5144. aStream.Read(Header[0], SizeOf(Header));
  5145. aStream.Position := StreamPos;
  5146. {Test if the header matches}
  5147. if Header = PngHeader then begin
  5148. Png := TPNGObject.Create;
  5149. try
  5150. Png.LoadFromStream(aStream);
  5151. case Png.Header.ColorType of
  5152. COLOR_GRAYSCALE:
  5153. PngFormat := tfLuminance8;
  5154. COLOR_GRAYSCALEALPHA:
  5155. PngFormat := tfLuminance8Alpha8;
  5156. COLOR_RGB:
  5157. PngFormat := tfBGR8;
  5158. COLOR_RGBALPHA:
  5159. PngFormat := tfBGRA8;
  5160. else
  5161. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5162. end;
  5163. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5164. PixSize := Round(FormatDesc.PixelSize);
  5165. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5166. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5167. try
  5168. pDest := NewImage;
  5169. case Png.Header.ColorType of
  5170. COLOR_RGB, COLOR_GRAYSCALE:
  5171. begin
  5172. for Row := 0 to Png.Height -1 do begin
  5173. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5174. Inc(pDest, LineSize);
  5175. end;
  5176. end;
  5177. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5178. begin
  5179. PixSize := PixSize -1;
  5180. for Row := 0 to Png.Height -1 do begin
  5181. pSource := Png.Scanline[Row];
  5182. pAlpha := pByte(Png.AlphaScanline[Row]);
  5183. for Col := 0 to Png.Width -1 do begin
  5184. Move (pSource^, pDest^, PixSize);
  5185. Inc(pSource, PixSize);
  5186. Inc(pDest, PixSize);
  5187. pDest^ := pAlpha^;
  5188. inc(pAlpha);
  5189. Inc(pDest);
  5190. end;
  5191. end;
  5192. end;
  5193. else
  5194. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5195. end;
  5196. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5197. result := true;
  5198. except
  5199. if Assigned(NewImage) then
  5200. FreeMem(NewImage);
  5201. raise;
  5202. end;
  5203. finally
  5204. Png.Free;
  5205. end;
  5206. end;
  5207. end;
  5208. {$IFEND}
  5209. {$ENDIF}
  5210. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5211. {$IFDEF GLB_LIB_PNG}
  5212. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5213. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5214. begin
  5215. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5216. end;
  5217. {$ENDIF}
  5218. {$IF DEFINED(GLB_LAZ_PNG)}
  5219. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5220. procedure TglBitmap.SavePNG(const aStream: TStream);
  5221. var
  5222. png: TPortableNetworkGraphic;
  5223. intf: TLazIntfImage;
  5224. raw: TRawImage;
  5225. begin
  5226. png := TPortableNetworkGraphic.Create;
  5227. intf := TLazIntfImage.Create(0, 0);
  5228. try
  5229. if not AssignToLazIntfImage(intf) then
  5230. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5231. intf.GetRawImage(raw);
  5232. png.LoadFromRawImage(raw, false);
  5233. png.SaveToStream(aStream);
  5234. finally
  5235. png.Free;
  5236. intf.Free;
  5237. end;
  5238. end;
  5239. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5240. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5241. procedure TglBitmap.SavePNG(const aStream: TStream);
  5242. var
  5243. png: png_structp;
  5244. png_info: png_infop;
  5245. png_rows: array of pByte;
  5246. LineSize: Integer;
  5247. ColorType: Integer;
  5248. Row: Integer;
  5249. FormatDesc: TFormatDescriptor;
  5250. begin
  5251. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5252. raise EglBitmapUnsupportedFormat.Create(Format);
  5253. if not init_libPNG then
  5254. raise Exception.Create('unable to initialize libPNG.');
  5255. try
  5256. case Format of
  5257. tfAlpha8, tfLuminance8:
  5258. ColorType := PNG_COLOR_TYPE_GRAY;
  5259. tfLuminance8Alpha8:
  5260. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5261. tfBGR8, tfRGB8:
  5262. ColorType := PNG_COLOR_TYPE_RGB;
  5263. tfBGRA8, tfRGBA8:
  5264. ColorType := PNG_COLOR_TYPE_RGBA;
  5265. else
  5266. raise EglBitmapUnsupportedFormat.Create(Format);
  5267. end;
  5268. FormatDesc := TFormatDescriptor.Get(Format);
  5269. LineSize := FormatDesc.GetSize(Width, 1);
  5270. // creating array for scanline
  5271. SetLength(png_rows, Height);
  5272. try
  5273. for Row := 0 to Height - 1 do begin
  5274. png_rows[Row] := Data;
  5275. Inc(png_rows[Row], Row * LineSize)
  5276. end;
  5277. // write struct
  5278. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5279. if png = nil then
  5280. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5281. // create png info
  5282. png_info := png_create_info_struct(png);
  5283. if png_info = nil then begin
  5284. png_destroy_write_struct(@png, nil);
  5285. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5286. end;
  5287. // set read callback
  5288. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5289. // set compression
  5290. png_set_compression_level(png, 6);
  5291. if Format in [tfBGR8, tfBGRA8] then
  5292. png_set_bgr(png);
  5293. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5294. png_write_info(png, png_info);
  5295. png_write_image(png, @png_rows[0]);
  5296. png_write_end(png, png_info);
  5297. png_destroy_write_struct(@png, @png_info);
  5298. finally
  5299. SetLength(png_rows, 0);
  5300. end;
  5301. finally
  5302. quit_libPNG;
  5303. end;
  5304. end;
  5305. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5306. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5307. procedure TglBitmap.SavePNG(const aStream: TStream);
  5308. var
  5309. Png: TPNGObject;
  5310. pSource, pDest: pByte;
  5311. X, Y, PixSize: Integer;
  5312. ColorType: Cardinal;
  5313. Alpha: Boolean;
  5314. pTemp: pByte;
  5315. Temp: Byte;
  5316. begin
  5317. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5318. raise EglBitmapUnsupportedFormat.Create(Format);
  5319. case Format of
  5320. tfAlpha8, tfLuminance8: begin
  5321. ColorType := COLOR_GRAYSCALE;
  5322. PixSize := 1;
  5323. Alpha := false;
  5324. end;
  5325. tfLuminance8Alpha8: begin
  5326. ColorType := COLOR_GRAYSCALEALPHA;
  5327. PixSize := 1;
  5328. Alpha := true;
  5329. end;
  5330. tfBGR8, tfRGB8: begin
  5331. ColorType := COLOR_RGB;
  5332. PixSize := 3;
  5333. Alpha := false;
  5334. end;
  5335. tfBGRA8, tfRGBA8: begin
  5336. ColorType := COLOR_RGBALPHA;
  5337. PixSize := 3;
  5338. Alpha := true
  5339. end;
  5340. else
  5341. raise EglBitmapUnsupportedFormat.Create(Format);
  5342. end;
  5343. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5344. try
  5345. // Copy ImageData
  5346. pSource := Data;
  5347. for Y := 0 to Height -1 do begin
  5348. pDest := png.ScanLine[Y];
  5349. for X := 0 to Width -1 do begin
  5350. Move(pSource^, pDest^, PixSize);
  5351. Inc(pDest, PixSize);
  5352. Inc(pSource, PixSize);
  5353. if Alpha then begin
  5354. png.AlphaScanline[Y]^[X] := pSource^;
  5355. Inc(pSource);
  5356. end;
  5357. end;
  5358. // convert RGB line to BGR
  5359. if Format in [tfRGB8, tfRGBA8] then begin
  5360. pTemp := png.ScanLine[Y];
  5361. for X := 0 to Width -1 do begin
  5362. Temp := pByteArray(pTemp)^[0];
  5363. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5364. pByteArray(pTemp)^[2] := Temp;
  5365. Inc(pTemp, 3);
  5366. end;
  5367. end;
  5368. end;
  5369. // Save to Stream
  5370. Png.CompressionLevel := 6;
  5371. Png.SaveToStream(aStream);
  5372. finally
  5373. FreeAndNil(Png);
  5374. end;
  5375. end;
  5376. {$IFEND}
  5377. {$ENDIF}
  5378. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5379. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5380. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5381. {$IFDEF GLB_LIB_JPEG}
  5382. type
  5383. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5384. glBitmap_libJPEG_source_mgr = record
  5385. pub: jpeg_source_mgr;
  5386. SrcStream: TStream;
  5387. SrcBuffer: array [1..4096] of byte;
  5388. end;
  5389. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5390. glBitmap_libJPEG_dest_mgr = record
  5391. pub: jpeg_destination_mgr;
  5392. DestStream: TStream;
  5393. DestBuffer: array [1..4096] of byte;
  5394. end;
  5395. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5396. begin
  5397. //DUMMY
  5398. end;
  5399. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5400. begin
  5401. //DUMMY
  5402. end;
  5403. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5404. begin
  5405. //DUMMY
  5406. end;
  5407. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5408. begin
  5409. //DUMMY
  5410. end;
  5411. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5412. begin
  5413. //DUMMY
  5414. end;
  5415. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5416. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5417. var
  5418. src: glBitmap_libJPEG_source_mgr_ptr;
  5419. bytes: integer;
  5420. begin
  5421. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5422. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5423. if (bytes <= 0) then begin
  5424. src^.SrcBuffer[1] := $FF;
  5425. src^.SrcBuffer[2] := JPEG_EOI;
  5426. bytes := 2;
  5427. end;
  5428. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5429. src^.pub.bytes_in_buffer := bytes;
  5430. result := true;
  5431. end;
  5432. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5433. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5434. var
  5435. src: glBitmap_libJPEG_source_mgr_ptr;
  5436. begin
  5437. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5438. if num_bytes > 0 then begin
  5439. // wanted byte isn't in buffer so set stream position and read buffer
  5440. if num_bytes > src^.pub.bytes_in_buffer then begin
  5441. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5442. src^.pub.fill_input_buffer(cinfo);
  5443. end else begin
  5444. // wanted byte is in buffer so only skip
  5445. inc(src^.pub.next_input_byte, num_bytes);
  5446. dec(src^.pub.bytes_in_buffer, num_bytes);
  5447. end;
  5448. end;
  5449. end;
  5450. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5451. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5452. var
  5453. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5454. begin
  5455. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5456. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5457. // write complete buffer
  5458. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5459. // reset buffer
  5460. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5461. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5462. end;
  5463. result := true;
  5464. end;
  5465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5466. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5467. var
  5468. Idx: Integer;
  5469. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5470. begin
  5471. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5472. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5473. // check for endblock
  5474. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5475. // write endblock
  5476. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5477. // leave
  5478. break;
  5479. end else
  5480. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5481. end;
  5482. end;
  5483. {$ENDIF}
  5484. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5485. {$IF DEFINED(GLB_LAZ_JPEG)}
  5486. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5487. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5488. const
  5489. MAGIC_LEN = 2;
  5490. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  5491. var
  5492. jpeg: TJPEGImage;
  5493. intf: TLazIntfImage;
  5494. StreamPos: Int64;
  5495. magic: String[MAGIC_LEN];
  5496. begin
  5497. result := true;
  5498. StreamPos := aStream.Position;
  5499. SetLength(magic, MAGIC_LEN);
  5500. aStream.Read(magic[1], MAGIC_LEN);
  5501. aStream.Position := StreamPos;
  5502. if (magic <> JPEG_MAGIC) then begin
  5503. result := false;
  5504. exit;
  5505. end;
  5506. jpeg := TJPEGImage.Create;
  5507. try try
  5508. jpeg.LoadFromStream(aStream);
  5509. intf := TLazIntfImage.Create(0, 0);
  5510. try try
  5511. intf.LoadFromBitmap(jpeg.BitmapHandle, jpeg.MaskHandle);
  5512. AssignFromLazIntfImage(intf);
  5513. except
  5514. result := false;
  5515. aStream.Position := StreamPos;
  5516. exit;
  5517. end;
  5518. finally
  5519. intf.Free;
  5520. end;
  5521. except
  5522. result := false;
  5523. aStream.Position := StreamPos;
  5524. exit;
  5525. end;
  5526. finally
  5527. jpeg.Free;
  5528. end;
  5529. end;
  5530. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5531. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5532. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5533. var
  5534. Surface: PSDL_Surface;
  5535. RWops: PSDL_RWops;
  5536. begin
  5537. result := false;
  5538. RWops := glBitmapCreateRWops(aStream);
  5539. try
  5540. if IMG_isJPG(RWops) > 0 then begin
  5541. Surface := IMG_LoadJPG_RW(RWops);
  5542. try
  5543. AssignFromSurface(Surface);
  5544. result := true;
  5545. finally
  5546. SDL_FreeSurface(Surface);
  5547. end;
  5548. end;
  5549. finally
  5550. SDL_FreeRW(RWops);
  5551. end;
  5552. end;
  5553. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5554. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5555. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5556. var
  5557. StreamPos: Int64;
  5558. Temp: array[0..1]of Byte;
  5559. jpeg: jpeg_decompress_struct;
  5560. jpeg_err: jpeg_error_mgr;
  5561. IntFormat: TglBitmapFormat;
  5562. pImage: pByte;
  5563. TempHeight, TempWidth: Integer;
  5564. pTemp: pByte;
  5565. Row: Integer;
  5566. FormatDesc: TFormatDescriptor;
  5567. begin
  5568. result := false;
  5569. if not init_libJPEG then
  5570. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5571. try
  5572. // reading first two bytes to test file and set cursor back to begin
  5573. StreamPos := aStream.Position;
  5574. aStream.Read({%H-}Temp[0], 2);
  5575. aStream.Position := StreamPos;
  5576. // if Bitmap then read file.
  5577. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5578. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5579. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5580. // error managment
  5581. jpeg.err := jpeg_std_error(@jpeg_err);
  5582. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5583. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5584. // decompression struct
  5585. jpeg_create_decompress(@jpeg);
  5586. // allocation space for streaming methods
  5587. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5588. // seeting up custom functions
  5589. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5590. pub.init_source := glBitmap_libJPEG_init_source;
  5591. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5592. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5593. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5594. pub.term_source := glBitmap_libJPEG_term_source;
  5595. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5596. pub.next_input_byte := nil; // until buffer loaded
  5597. SrcStream := aStream;
  5598. end;
  5599. // set global decoding state
  5600. jpeg.global_state := DSTATE_START;
  5601. // read header of jpeg
  5602. jpeg_read_header(@jpeg, false);
  5603. // setting output parameter
  5604. case jpeg.jpeg_color_space of
  5605. JCS_GRAYSCALE:
  5606. begin
  5607. jpeg.out_color_space := JCS_GRAYSCALE;
  5608. IntFormat := tfLuminance8;
  5609. end;
  5610. else
  5611. jpeg.out_color_space := JCS_RGB;
  5612. IntFormat := tfRGB8;
  5613. end;
  5614. // reading image
  5615. jpeg_start_decompress(@jpeg);
  5616. TempHeight := jpeg.output_height;
  5617. TempWidth := jpeg.output_width;
  5618. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5619. // creating new image
  5620. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5621. try
  5622. pTemp := pImage;
  5623. for Row := 0 to TempHeight -1 do begin
  5624. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5625. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5626. end;
  5627. // finish decompression
  5628. jpeg_finish_decompress(@jpeg);
  5629. // destroy decompression
  5630. jpeg_destroy_decompress(@jpeg);
  5631. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5632. result := true;
  5633. except
  5634. if Assigned(pImage) then
  5635. FreeMem(pImage);
  5636. raise;
  5637. end;
  5638. end;
  5639. finally
  5640. quit_libJPEG;
  5641. end;
  5642. end;
  5643. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5644. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5645. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5646. var
  5647. bmp: TBitmap;
  5648. jpg: TJPEGImage;
  5649. StreamPos: Int64;
  5650. Temp: array[0..1]of Byte;
  5651. begin
  5652. result := false;
  5653. // reading first two bytes to test file and set cursor back to begin
  5654. StreamPos := aStream.Position;
  5655. aStream.Read(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. bmp := TBitmap.Create;
  5660. try
  5661. jpg := TJPEGImage.Create;
  5662. try
  5663. jpg.LoadFromStream(aStream);
  5664. bmp.Assign(jpg);
  5665. result := AssignFromBitmap(bmp);
  5666. finally
  5667. jpg.Free;
  5668. end;
  5669. finally
  5670. bmp.Free;
  5671. end;
  5672. end;
  5673. end;
  5674. {$IFEND}
  5675. {$ENDIF}
  5676. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5677. {$IF DEFINED(GLB_LAZ_JPEG)}
  5678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5679. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5680. var
  5681. jpeg: TJPEGImage;
  5682. intf: TLazIntfImage;
  5683. raw: TRawImage;
  5684. begin
  5685. jpeg := TJPEGImage.Create;
  5686. intf := TLazIntfImage.Create(0, 0);
  5687. try
  5688. if not AssignToLazIntfImage(intf) then
  5689. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5690. intf.GetRawImage(raw);
  5691. jpeg.LoadFromRawImage(raw, false);
  5692. jpeg.SaveToStream(aStream);
  5693. finally
  5694. intf.Free;
  5695. jpeg.Free;
  5696. end;
  5697. end;
  5698. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5699. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5700. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5701. var
  5702. jpeg: jpeg_compress_struct;
  5703. jpeg_err: jpeg_error_mgr;
  5704. Row: Integer;
  5705. pTemp, pTemp2: pByte;
  5706. procedure CopyRow(pDest, pSource: pByte);
  5707. var
  5708. X: Integer;
  5709. begin
  5710. for X := 0 to Width - 1 do begin
  5711. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5712. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5713. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5714. Inc(pDest, 3);
  5715. Inc(pSource, 3);
  5716. end;
  5717. end;
  5718. begin
  5719. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5720. raise EglBitmapUnsupportedFormat.Create(Format);
  5721. if not init_libJPEG then
  5722. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5723. try
  5724. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  5725. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5726. // error managment
  5727. jpeg.err := jpeg_std_error(@jpeg_err);
  5728. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5729. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5730. // compression struct
  5731. jpeg_create_compress(@jpeg);
  5732. // allocation space for streaming methods
  5733. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5734. // seeting up custom functions
  5735. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5736. pub.init_destination := glBitmap_libJPEG_init_destination;
  5737. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5738. pub.term_destination := glBitmap_libJPEG_term_destination;
  5739. pub.next_output_byte := @DestBuffer[1];
  5740. pub.free_in_buffer := Length(DestBuffer);
  5741. DestStream := aStream;
  5742. end;
  5743. // very important state
  5744. jpeg.global_state := CSTATE_START;
  5745. jpeg.image_width := Width;
  5746. jpeg.image_height := Height;
  5747. case Format of
  5748. tfAlpha8, tfLuminance8: begin
  5749. jpeg.input_components := 1;
  5750. jpeg.in_color_space := JCS_GRAYSCALE;
  5751. end;
  5752. tfRGB8, tfBGR8: begin
  5753. jpeg.input_components := 3;
  5754. jpeg.in_color_space := JCS_RGB;
  5755. end;
  5756. end;
  5757. jpeg_set_defaults(@jpeg);
  5758. jpeg_set_quality(@jpeg, 95, true);
  5759. jpeg_start_compress(@jpeg, true);
  5760. pTemp := Data;
  5761. if Format = tfBGR8 then
  5762. GetMem(pTemp2, fRowSize)
  5763. else
  5764. pTemp2 := pTemp;
  5765. try
  5766. for Row := 0 to jpeg.image_height -1 do begin
  5767. // prepare row
  5768. if Format = tfBGR8 then
  5769. CopyRow(pTemp2, pTemp)
  5770. else
  5771. pTemp2 := pTemp;
  5772. // write row
  5773. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5774. inc(pTemp, fRowSize);
  5775. end;
  5776. finally
  5777. // free memory
  5778. if Format = tfBGR8 then
  5779. FreeMem(pTemp2);
  5780. end;
  5781. jpeg_finish_compress(@jpeg);
  5782. jpeg_destroy_compress(@jpeg);
  5783. finally
  5784. quit_libJPEG;
  5785. end;
  5786. end;
  5787. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5788. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5789. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5790. var
  5791. Bmp: TBitmap;
  5792. Jpg: TJPEGImage;
  5793. begin
  5794. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5795. raise EglBitmapUnsupportedFormat.Create(Format);
  5796. Bmp := TBitmap.Create;
  5797. try
  5798. Jpg := TJPEGImage.Create;
  5799. try
  5800. AssignToBitmap(Bmp);
  5801. if (Format in [tfAlpha8, tfLuminance8]) then begin
  5802. Jpg.Grayscale := true;
  5803. Jpg.PixelFormat := jf8Bit;
  5804. end;
  5805. Jpg.Assign(Bmp);
  5806. Jpg.SaveToStream(aStream);
  5807. finally
  5808. FreeAndNil(Jpg);
  5809. end;
  5810. finally
  5811. FreeAndNil(Bmp);
  5812. end;
  5813. end;
  5814. {$IFEND}
  5815. {$ENDIF}
  5816. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5817. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5818. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5819. const
  5820. BMP_MAGIC = $4D42;
  5821. BMP_COMP_RGB = 0;
  5822. BMP_COMP_RLE8 = 1;
  5823. BMP_COMP_RLE4 = 2;
  5824. BMP_COMP_BITFIELDS = 3;
  5825. type
  5826. TBMPHeader = packed record
  5827. bfType: Word;
  5828. bfSize: Cardinal;
  5829. bfReserved1: Word;
  5830. bfReserved2: Word;
  5831. bfOffBits: Cardinal;
  5832. end;
  5833. TBMPInfo = packed record
  5834. biSize: Cardinal;
  5835. biWidth: Longint;
  5836. biHeight: Longint;
  5837. biPlanes: Word;
  5838. biBitCount: Word;
  5839. biCompression: Cardinal;
  5840. biSizeImage: Cardinal;
  5841. biXPelsPerMeter: Longint;
  5842. biYPelsPerMeter: Longint;
  5843. biClrUsed: Cardinal;
  5844. biClrImportant: Cardinal;
  5845. end;
  5846. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5847. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5848. //////////////////////////////////////////////////////////////////////////////////////////////////
  5849. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5850. begin
  5851. result := tfEmpty;
  5852. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5853. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5854. //Read Compression
  5855. case aInfo.biCompression of
  5856. BMP_COMP_RLE4,
  5857. BMP_COMP_RLE8: begin
  5858. raise EglBitmap.Create('RLE compression is not supported');
  5859. end;
  5860. BMP_COMP_BITFIELDS: begin
  5861. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5862. aStream.Read(aMask.r, SizeOf(aMask.r));
  5863. aStream.Read(aMask.g, SizeOf(aMask.g));
  5864. aStream.Read(aMask.b, SizeOf(aMask.b));
  5865. aStream.Read(aMask.a, SizeOf(aMask.a));
  5866. end else
  5867. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  5868. end;
  5869. end;
  5870. //get suitable format
  5871. case aInfo.biBitCount of
  5872. 8: result := tfLuminance8;
  5873. 16: result := tfBGR5;
  5874. 24: result := tfBGR8;
  5875. 32: result := tfBGRA8;
  5876. end;
  5877. end;
  5878. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5879. var
  5880. i, c: Integer;
  5881. ColorTable: TbmpColorTable;
  5882. begin
  5883. result := nil;
  5884. if (aInfo.biBitCount >= 16) then
  5885. exit;
  5886. aFormat := tfLuminance8;
  5887. c := aInfo.biClrUsed;
  5888. if (c = 0) then
  5889. c := 1 shl aInfo.biBitCount;
  5890. SetLength(ColorTable, c);
  5891. for i := 0 to c-1 do begin
  5892. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5893. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5894. aFormat := tfRGB8;
  5895. end;
  5896. result := TbmpColorTableFormat.Create;
  5897. result.PixelSize := aInfo.biBitCount / 8;
  5898. result.ColorTable := ColorTable;
  5899. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5900. end;
  5901. //////////////////////////////////////////////////////////////////////////////////////////////////
  5902. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5903. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5904. var
  5905. TmpFormat: TglBitmapFormat;
  5906. FormatDesc: TFormatDescriptor;
  5907. begin
  5908. result := nil;
  5909. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5910. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5911. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5912. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5913. aFormat := FormatDesc.Format;
  5914. exit;
  5915. end;
  5916. end;
  5917. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5918. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5919. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5920. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5921. result := TbmpBitfieldFormat.Create;
  5922. result.PixelSize := aInfo.biBitCount / 8;
  5923. result.RedMask := aMask.r;
  5924. result.GreenMask := aMask.g;
  5925. result.BlueMask := aMask.b;
  5926. result.AlphaMask := aMask.a;
  5927. end;
  5928. end;
  5929. var
  5930. //simple types
  5931. StartPos: Int64;
  5932. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5933. PaddingBuff: Cardinal;
  5934. LineBuf, ImageData, TmpData: PByte;
  5935. SourceMD, DestMD: Pointer;
  5936. BmpFormat: TglBitmapFormat;
  5937. //records
  5938. Mask: TglBitmapColorRec;
  5939. Header: TBMPHeader;
  5940. Info: TBMPInfo;
  5941. //classes
  5942. SpecialFormat: TFormatDescriptor;
  5943. FormatDesc: TFormatDescriptor;
  5944. //////////////////////////////////////////////////////////////////////////////////////////////////
  5945. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  5946. var
  5947. i: Integer;
  5948. Pixel: TglBitmapPixelData;
  5949. begin
  5950. aStream.Read(aLineBuf^, rbLineSize);
  5951. SpecialFormat.PreparePixel(Pixel);
  5952. for i := 0 to Info.biWidth-1 do begin
  5953. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  5954. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  5955. FormatDesc.Map(Pixel, aData, DestMD);
  5956. end;
  5957. end;
  5958. begin
  5959. result := false;
  5960. BmpFormat := tfEmpty;
  5961. SpecialFormat := nil;
  5962. LineBuf := nil;
  5963. SourceMD := nil;
  5964. DestMD := nil;
  5965. // Header
  5966. StartPos := aStream.Position;
  5967. aStream.Read(Header{%H-}, SizeOf(Header));
  5968. if Header.bfType = BMP_MAGIC then begin
  5969. try try
  5970. BmpFormat := ReadInfo(Info, Mask);
  5971. SpecialFormat := ReadColorTable(BmpFormat, Info);
  5972. if not Assigned(SpecialFormat) then
  5973. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  5974. aStream.Position := StartPos + Header.bfOffBits;
  5975. if (BmpFormat <> tfEmpty) then begin
  5976. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  5977. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  5978. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  5979. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  5980. //get Memory
  5981. DestMD := FormatDesc.CreateMappingData;
  5982. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  5983. GetMem(ImageData, ImageSize);
  5984. if Assigned(SpecialFormat) then begin
  5985. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  5986. SourceMD := SpecialFormat.CreateMappingData;
  5987. end;
  5988. //read Data
  5989. try try
  5990. FillChar(ImageData^, ImageSize, $FF);
  5991. TmpData := ImageData;
  5992. if (Info.biHeight > 0) then
  5993. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  5994. for i := 0 to Abs(Info.biHeight)-1 do begin
  5995. if Assigned(SpecialFormat) then
  5996. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  5997. else
  5998. aStream.Read(TmpData^, wbLineSize); //else only read data
  5999. if (Info.biHeight > 0) then
  6000. dec(TmpData, wbLineSize)
  6001. else
  6002. inc(TmpData, wbLineSize);
  6003. aStream.Read(PaddingBuff{%H-}, Padding);
  6004. end;
  6005. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6006. result := true;
  6007. finally
  6008. if Assigned(LineBuf) then
  6009. FreeMem(LineBuf);
  6010. if Assigned(SourceMD) then
  6011. SpecialFormat.FreeMappingData(SourceMD);
  6012. FormatDesc.FreeMappingData(DestMD);
  6013. end;
  6014. except
  6015. if Assigned(ImageData) then
  6016. FreeMem(ImageData);
  6017. raise;
  6018. end;
  6019. end else
  6020. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6021. except
  6022. aStream.Position := StartPos;
  6023. raise;
  6024. end;
  6025. finally
  6026. FreeAndNil(SpecialFormat);
  6027. end;
  6028. end
  6029. else aStream.Position := StartPos;
  6030. end;
  6031. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6032. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6033. var
  6034. Header: TBMPHeader;
  6035. Info: TBMPInfo;
  6036. Converter: TFormatDescriptor;
  6037. FormatDesc: TFormatDescriptor;
  6038. SourceFD, DestFD: Pointer;
  6039. pData, srcData, dstData, ConvertBuffer: pByte;
  6040. Pixel: TglBitmapPixelData;
  6041. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6042. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6043. PaddingBuff: Cardinal;
  6044. function GetLineWidth : Integer;
  6045. begin
  6046. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6047. end;
  6048. begin
  6049. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6050. raise EglBitmapUnsupportedFormat.Create(Format);
  6051. Converter := nil;
  6052. FormatDesc := TFormatDescriptor.Get(Format);
  6053. ImageSize := FormatDesc.GetSize(Dimension);
  6054. FillChar(Header{%H-}, SizeOf(Header), 0);
  6055. Header.bfType := BMP_MAGIC;
  6056. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6057. Header.bfReserved1 := 0;
  6058. Header.bfReserved2 := 0;
  6059. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6060. FillChar(Info{%H-}, SizeOf(Info), 0);
  6061. Info.biSize := SizeOf(Info);
  6062. Info.biWidth := Width;
  6063. Info.biHeight := Height;
  6064. Info.biPlanes := 1;
  6065. Info.biCompression := BMP_COMP_RGB;
  6066. Info.biSizeImage := ImageSize;
  6067. try
  6068. case Format of
  6069. tfLuminance4: begin
  6070. Info.biBitCount := 4;
  6071. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  6072. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  6073. Converter := TbmpColorTableFormat.Create;
  6074. with (Converter as TbmpColorTableFormat) do begin
  6075. PixelSize := 0.5;
  6076. Format := Format;
  6077. Range := glBitmapColorRec($F, $F, $F, $0);
  6078. CreateColorTable;
  6079. end;
  6080. end;
  6081. tfR3G3B2, tfLuminance8: begin
  6082. Info.biBitCount := 8;
  6083. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6084. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6085. Converter := TbmpColorTableFormat.Create;
  6086. with (Converter as TbmpColorTableFormat) do begin
  6087. PixelSize := 1;
  6088. Format := Format;
  6089. if (Format = tfR3G3B2) then begin
  6090. Range := glBitmapColorRec($7, $7, $3, $0);
  6091. Shift := glBitmapShiftRec(0, 3, 6, 0);
  6092. end else
  6093. Range := glBitmapColorRec($FF, $FF, $FF, $0);
  6094. CreateColorTable;
  6095. end;
  6096. end;
  6097. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  6098. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  6099. Info.biBitCount := 16;
  6100. Info.biCompression := BMP_COMP_BITFIELDS;
  6101. end;
  6102. tfBGR8, tfRGB8: begin
  6103. Info.biBitCount := 24;
  6104. if (Format = tfRGB8) then
  6105. Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6106. end;
  6107. tfRGB10, tfRGB10A2, tfRGBA8,
  6108. tfBGR10, tfBGR10A2, tfBGRA8: begin
  6109. Info.biBitCount := 32;
  6110. Info.biCompression := BMP_COMP_BITFIELDS;
  6111. end;
  6112. else
  6113. raise EglBitmapUnsupportedFormat.Create(Format);
  6114. end;
  6115. Info.biXPelsPerMeter := 2835;
  6116. Info.biYPelsPerMeter := 2835;
  6117. // prepare bitmasks
  6118. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6119. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6120. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6121. RedMask := FormatDesc.RedMask;
  6122. GreenMask := FormatDesc.GreenMask;
  6123. BlueMask := FormatDesc.BlueMask;
  6124. AlphaMask := FormatDesc.AlphaMask;
  6125. end;
  6126. // headers
  6127. aStream.Write(Header, SizeOf(Header));
  6128. aStream.Write(Info, SizeOf(Info));
  6129. // colortable
  6130. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6131. with (Converter as TbmpColorTableFormat) do
  6132. aStream.Write(ColorTable[0].b,
  6133. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6134. // bitmasks
  6135. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6136. aStream.Write(RedMask, SizeOf(Cardinal));
  6137. aStream.Write(GreenMask, SizeOf(Cardinal));
  6138. aStream.Write(BlueMask, SizeOf(Cardinal));
  6139. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6140. end;
  6141. // image data
  6142. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  6143. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6144. Padding := GetLineWidth - wbLineSize;
  6145. PaddingBuff := 0;
  6146. pData := Data;
  6147. inc(pData, (Height-1) * rbLineSize);
  6148. // prepare row buffer. But only for RGB because RGBA supports color masks
  6149. // so it's possible to change color within the image.
  6150. if Assigned(Converter) then begin
  6151. FormatDesc.PreparePixel(Pixel);
  6152. GetMem(ConvertBuffer, wbLineSize);
  6153. SourceFD := FormatDesc.CreateMappingData;
  6154. DestFD := Converter.CreateMappingData;
  6155. end else
  6156. ConvertBuffer := nil;
  6157. try
  6158. for LineIdx := 0 to Height - 1 do begin
  6159. // preparing row
  6160. if Assigned(Converter) then begin
  6161. srcData := pData;
  6162. dstData := ConvertBuffer;
  6163. for PixelIdx := 0 to Info.biWidth-1 do begin
  6164. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6165. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6166. Converter.Map(Pixel, dstData, DestFD);
  6167. end;
  6168. aStream.Write(ConvertBuffer^, wbLineSize);
  6169. end else begin
  6170. aStream.Write(pData^, rbLineSize);
  6171. end;
  6172. dec(pData, rbLineSize);
  6173. if (Padding > 0) then
  6174. aStream.Write(PaddingBuff, Padding);
  6175. end;
  6176. finally
  6177. // destroy row buffer
  6178. if Assigned(ConvertBuffer) then begin
  6179. FormatDesc.FreeMappingData(SourceFD);
  6180. Converter.FreeMappingData(DestFD);
  6181. FreeMem(ConvertBuffer);
  6182. end;
  6183. end;
  6184. finally
  6185. if Assigned(Converter) then
  6186. Converter.Free;
  6187. end;
  6188. end;
  6189. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6190. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6191. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6192. type
  6193. TTGAHeader = packed record
  6194. ImageID: Byte;
  6195. ColorMapType: Byte;
  6196. ImageType: Byte;
  6197. //ColorMapSpec: Array[0..4] of Byte;
  6198. ColorMapStart: Word;
  6199. ColorMapLength: Word;
  6200. ColorMapEntrySize: Byte;
  6201. OrigX: Word;
  6202. OrigY: Word;
  6203. Width: Word;
  6204. Height: Word;
  6205. Bpp: Byte;
  6206. ImageDesc: Byte;
  6207. end;
  6208. const
  6209. TGA_UNCOMPRESSED_RGB = 2;
  6210. TGA_UNCOMPRESSED_GRAY = 3;
  6211. TGA_COMPRESSED_RGB = 10;
  6212. TGA_COMPRESSED_GRAY = 11;
  6213. TGA_NONE_COLOR_TABLE = 0;
  6214. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6215. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6216. var
  6217. Header: TTGAHeader;
  6218. ImageData: System.PByte;
  6219. StartPosition: Int64;
  6220. PixelSize, LineSize: Integer;
  6221. tgaFormat: TglBitmapFormat;
  6222. FormatDesc: TFormatDescriptor;
  6223. Counter: packed record
  6224. X, Y: packed record
  6225. low, high, dir: Integer;
  6226. end;
  6227. end;
  6228. const
  6229. CACHE_SIZE = $4000;
  6230. ////////////////////////////////////////////////////////////////////////////////////////
  6231. procedure ReadUncompressed;
  6232. var
  6233. i, j: Integer;
  6234. buf, tmp1, tmp2: System.PByte;
  6235. begin
  6236. buf := nil;
  6237. if (Counter.X.dir < 0) then
  6238. GetMem(buf, LineSize);
  6239. try
  6240. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6241. tmp1 := ImageData;
  6242. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6243. if (Counter.X.dir < 0) then begin //flip X
  6244. aStream.Read(buf^, LineSize);
  6245. tmp2 := buf;
  6246. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6247. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6248. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6249. tmp1^ := tmp2^;
  6250. inc(tmp1);
  6251. inc(tmp2);
  6252. end;
  6253. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6254. end;
  6255. end else
  6256. aStream.Read(tmp1^, LineSize);
  6257. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6258. end;
  6259. finally
  6260. if Assigned(buf) then
  6261. FreeMem(buf);
  6262. end;
  6263. end;
  6264. ////////////////////////////////////////////////////////////////////////////////////////
  6265. procedure ReadCompressed;
  6266. /////////////////////////////////////////////////////////////////
  6267. var
  6268. TmpData: System.PByte;
  6269. LinePixelsRead: Integer;
  6270. procedure CheckLine;
  6271. begin
  6272. if (LinePixelsRead >= Header.Width) then begin
  6273. LinePixelsRead := 0;
  6274. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6275. TmpData := ImageData;
  6276. inc(TmpData, Counter.Y.low * LineSize); //set line
  6277. if (Counter.X.dir < 0) then //if x flipped then
  6278. inc(TmpData, LineSize - PixelSize); //set last pixel
  6279. end;
  6280. end;
  6281. /////////////////////////////////////////////////////////////////
  6282. var
  6283. Cache: PByte;
  6284. CacheSize, CachePos: Integer;
  6285. procedure CachedRead(out Buffer; Count: Integer);
  6286. var
  6287. BytesRead: Integer;
  6288. begin
  6289. if (CachePos + Count > CacheSize) then begin
  6290. //if buffer overflow save non read bytes
  6291. BytesRead := 0;
  6292. if (CacheSize - CachePos > 0) then begin
  6293. BytesRead := CacheSize - CachePos;
  6294. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6295. inc(CachePos, BytesRead);
  6296. end;
  6297. //load cache from file
  6298. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6299. aStream.Read(Cache^, CacheSize);
  6300. CachePos := 0;
  6301. //read rest of requested bytes
  6302. if (Count - BytesRead > 0) then begin
  6303. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6304. inc(CachePos, Count - BytesRead);
  6305. end;
  6306. end else begin
  6307. //if no buffer overflow just read the data
  6308. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6309. inc(CachePos, Count);
  6310. end;
  6311. end;
  6312. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6313. begin
  6314. case PixelSize of
  6315. 1: begin
  6316. aBuffer^ := aData^;
  6317. inc(aBuffer, Counter.X.dir);
  6318. end;
  6319. 2: begin
  6320. PWord(aBuffer)^ := PWord(aData)^;
  6321. inc(aBuffer, 2 * Counter.X.dir);
  6322. end;
  6323. 3: begin
  6324. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6325. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6326. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6327. inc(aBuffer, 3 * Counter.X.dir);
  6328. end;
  6329. 4: begin
  6330. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6331. inc(aBuffer, 4 * Counter.X.dir);
  6332. end;
  6333. end;
  6334. end;
  6335. var
  6336. TotalPixelsToRead, TotalPixelsRead: Integer;
  6337. Temp: Byte;
  6338. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6339. PixelRepeat: Boolean;
  6340. PixelsToRead, PixelCount: Integer;
  6341. begin
  6342. CacheSize := 0;
  6343. CachePos := 0;
  6344. TotalPixelsToRead := Header.Width * Header.Height;
  6345. TotalPixelsRead := 0;
  6346. LinePixelsRead := 0;
  6347. GetMem(Cache, CACHE_SIZE);
  6348. try
  6349. TmpData := ImageData;
  6350. inc(TmpData, Counter.Y.low * LineSize); //set line
  6351. if (Counter.X.dir < 0) then //if x flipped then
  6352. inc(TmpData, LineSize - PixelSize); //set last pixel
  6353. repeat
  6354. //read CommandByte
  6355. CachedRead(Temp, 1);
  6356. PixelRepeat := (Temp and $80) > 0;
  6357. PixelsToRead := (Temp and $7F) + 1;
  6358. inc(TotalPixelsRead, PixelsToRead);
  6359. if PixelRepeat then
  6360. CachedRead(buf[0], PixelSize);
  6361. while (PixelsToRead > 0) do begin
  6362. CheckLine;
  6363. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6364. while (PixelCount > 0) do begin
  6365. if not PixelRepeat then
  6366. CachedRead(buf[0], PixelSize);
  6367. PixelToBuffer(@buf[0], TmpData);
  6368. inc(LinePixelsRead);
  6369. dec(PixelsToRead);
  6370. dec(PixelCount);
  6371. end;
  6372. end;
  6373. until (TotalPixelsRead >= TotalPixelsToRead);
  6374. finally
  6375. FreeMem(Cache);
  6376. end;
  6377. end;
  6378. function IsGrayFormat: Boolean;
  6379. begin
  6380. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6381. end;
  6382. begin
  6383. result := false;
  6384. // reading header to test file and set cursor back to begin
  6385. StartPosition := aStream.Position;
  6386. aStream.Read(Header{%H-}, SizeOf(Header));
  6387. // no colormapped files
  6388. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6389. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6390. begin
  6391. try
  6392. if Header.ImageID <> 0 then // skip image ID
  6393. aStream.Position := aStream.Position + Header.ImageID;
  6394. tgaFormat := tfEmpty;
  6395. case Header.Bpp of
  6396. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6397. 0: tgaFormat := tfLuminance8;
  6398. 8: tgaFormat := tfAlpha8;
  6399. end;
  6400. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6401. 0: tgaFormat := tfLuminance16;
  6402. 8: tgaFormat := tfLuminance8Alpha8;
  6403. end else case (Header.ImageDesc and $F) of
  6404. 0: tgaFormat := tfBGR5;
  6405. 1: tgaFormat := tfBGR5A1;
  6406. 4: tgaFormat := tfBGRA4;
  6407. end;
  6408. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6409. 0: tgaFormat := tfBGR8;
  6410. end;
  6411. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6412. 2: tgaFormat := tfBGR10A2;
  6413. 8: tgaFormat := tfBGRA8;
  6414. end;
  6415. end;
  6416. if (tgaFormat = tfEmpty) then
  6417. raise EglBitmap.Create('LoadTga - unsupported format');
  6418. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6419. PixelSize := FormatDesc.GetSize(1, 1);
  6420. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6421. GetMem(ImageData, LineSize * Header.Height);
  6422. try
  6423. //column direction
  6424. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6425. Counter.X.low := Header.Height-1;;
  6426. Counter.X.high := 0;
  6427. Counter.X.dir := -1;
  6428. end else begin
  6429. Counter.X.low := 0;
  6430. Counter.X.high := Header.Height-1;
  6431. Counter.X.dir := 1;
  6432. end;
  6433. // Row direction
  6434. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6435. Counter.Y.low := 0;
  6436. Counter.Y.high := Header.Height-1;
  6437. Counter.Y.dir := 1;
  6438. end else begin
  6439. Counter.Y.low := Header.Height-1;;
  6440. Counter.Y.high := 0;
  6441. Counter.Y.dir := -1;
  6442. end;
  6443. // Read Image
  6444. case Header.ImageType of
  6445. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6446. ReadUncompressed;
  6447. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6448. ReadCompressed;
  6449. end;
  6450. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6451. result := true;
  6452. except
  6453. if Assigned(ImageData) then
  6454. FreeMem(ImageData);
  6455. raise;
  6456. end;
  6457. finally
  6458. aStream.Position := StartPosition;
  6459. end;
  6460. end
  6461. else aStream.Position := StartPosition;
  6462. end;
  6463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6464. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6465. var
  6466. Header: TTGAHeader;
  6467. LineSize, Size, x, y: Integer;
  6468. Pixel: TglBitmapPixelData;
  6469. LineBuf, SourceData, DestData: PByte;
  6470. SourceMD, DestMD: Pointer;
  6471. FormatDesc: TFormatDescriptor;
  6472. Converter: TFormatDescriptor;
  6473. begin
  6474. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6475. raise EglBitmapUnsupportedFormat.Create(Format);
  6476. //prepare header
  6477. FillChar(Header{%H-}, SizeOf(Header), 0);
  6478. //set ImageType
  6479. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6480. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6481. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6482. else
  6483. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6484. //set BitsPerPixel
  6485. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6486. Header.Bpp := 8
  6487. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6488. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6489. Header.Bpp := 16
  6490. else if (Format in [tfBGR8, tfRGB8]) then
  6491. Header.Bpp := 24
  6492. else
  6493. Header.Bpp := 32;
  6494. //set AlphaBitCount
  6495. case Format of
  6496. tfRGB5A1, tfBGR5A1:
  6497. Header.ImageDesc := 1 and $F;
  6498. tfRGB10A2, tfBGR10A2:
  6499. Header.ImageDesc := 2 and $F;
  6500. tfRGBA4, tfBGRA4:
  6501. Header.ImageDesc := 4 and $F;
  6502. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6503. Header.ImageDesc := 8 and $F;
  6504. end;
  6505. Header.Width := Width;
  6506. Header.Height := Height;
  6507. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6508. aStream.Write(Header, SizeOf(Header));
  6509. // convert RGB(A) to BGR(A)
  6510. Converter := nil;
  6511. FormatDesc := TFormatDescriptor.Get(Format);
  6512. Size := FormatDesc.GetSize(Dimension);
  6513. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6514. if (FormatDesc.RGBInverted = tfEmpty) then
  6515. raise EglBitmap.Create('inverted RGB format is empty');
  6516. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6517. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6518. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6519. raise EglBitmap.Create('invalid inverted RGB format');
  6520. end;
  6521. if Assigned(Converter) then begin
  6522. LineSize := FormatDesc.GetSize(Width, 1);
  6523. GetMem(LineBuf, LineSize);
  6524. SourceMD := FormatDesc.CreateMappingData;
  6525. DestMD := Converter.CreateMappingData;
  6526. try
  6527. SourceData := Data;
  6528. for y := 0 to Height-1 do begin
  6529. DestData := LineBuf;
  6530. for x := 0 to Width-1 do begin
  6531. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6532. Converter.Map(Pixel, DestData, DestMD);
  6533. end;
  6534. aStream.Write(LineBuf^, LineSize);
  6535. end;
  6536. finally
  6537. FreeMem(LineBuf);
  6538. FormatDesc.FreeMappingData(SourceMD);
  6539. FormatDesc.FreeMappingData(DestMD);
  6540. end;
  6541. end else
  6542. aStream.Write(Data^, Size);
  6543. end;
  6544. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6545. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6546. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6547. const
  6548. DDS_MAGIC: Cardinal = $20534444;
  6549. // DDS_header.dwFlags
  6550. DDSD_CAPS = $00000001;
  6551. DDSD_HEIGHT = $00000002;
  6552. DDSD_WIDTH = $00000004;
  6553. DDSD_PIXELFORMAT = $00001000;
  6554. // DDS_header.sPixelFormat.dwFlags
  6555. DDPF_ALPHAPIXELS = $00000001;
  6556. DDPF_ALPHA = $00000002;
  6557. DDPF_FOURCC = $00000004;
  6558. DDPF_RGB = $00000040;
  6559. DDPF_LUMINANCE = $00020000;
  6560. // DDS_header.sCaps.dwCaps1
  6561. DDSCAPS_TEXTURE = $00001000;
  6562. // DDS_header.sCaps.dwCaps2
  6563. DDSCAPS2_CUBEMAP = $00000200;
  6564. D3DFMT_DXT1 = $31545844;
  6565. D3DFMT_DXT3 = $33545844;
  6566. D3DFMT_DXT5 = $35545844;
  6567. type
  6568. TDDSPixelFormat = packed record
  6569. dwSize: Cardinal;
  6570. dwFlags: Cardinal;
  6571. dwFourCC: Cardinal;
  6572. dwRGBBitCount: Cardinal;
  6573. dwRBitMask: Cardinal;
  6574. dwGBitMask: Cardinal;
  6575. dwBBitMask: Cardinal;
  6576. dwABitMask: Cardinal;
  6577. end;
  6578. TDDSCaps = packed record
  6579. dwCaps1: Cardinal;
  6580. dwCaps2: Cardinal;
  6581. dwDDSX: Cardinal;
  6582. dwReserved: Cardinal;
  6583. end;
  6584. TDDSHeader = packed record
  6585. dwSize: Cardinal;
  6586. dwFlags: Cardinal;
  6587. dwHeight: Cardinal;
  6588. dwWidth: Cardinal;
  6589. dwPitchOrLinearSize: Cardinal;
  6590. dwDepth: Cardinal;
  6591. dwMipMapCount: Cardinal;
  6592. dwReserved: array[0..10] of Cardinal;
  6593. PixelFormat: TDDSPixelFormat;
  6594. Caps: TDDSCaps;
  6595. dwReserved2: Cardinal;
  6596. end;
  6597. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6598. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6599. var
  6600. Header: TDDSHeader;
  6601. Converter: TbmpBitfieldFormat;
  6602. function GetDDSFormat: TglBitmapFormat;
  6603. var
  6604. fd: TFormatDescriptor;
  6605. i: Integer;
  6606. Range: TglBitmapColorRec;
  6607. match: Boolean;
  6608. begin
  6609. result := tfEmpty;
  6610. with Header.PixelFormat do begin
  6611. // Compresses
  6612. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6613. case Header.PixelFormat.dwFourCC of
  6614. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6615. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6616. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6617. end;
  6618. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6619. //find matching format
  6620. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6621. fd := TFormatDescriptor.Get(result);
  6622. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6623. (8 * fd.PixelSize = dwRGBBitCount) then
  6624. exit;
  6625. end;
  6626. //find format with same Range
  6627. Range.r := dwRBitMask;
  6628. Range.g := dwGBitMask;
  6629. Range.b := dwBBitMask;
  6630. Range.a := dwABitMask;
  6631. for i := 0 to 3 do begin
  6632. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6633. Range.arr[i] := Range.arr[i] shr 1;
  6634. end;
  6635. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6636. fd := TFormatDescriptor.Get(result);
  6637. match := true;
  6638. for i := 0 to 3 do
  6639. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6640. match := false;
  6641. break;
  6642. end;
  6643. if match then
  6644. break;
  6645. end;
  6646. //no format with same range found -> use default
  6647. if (result = tfEmpty) then begin
  6648. if (dwABitMask > 0) then
  6649. result := tfBGRA8
  6650. else
  6651. result := tfBGR8;
  6652. end;
  6653. Converter := TbmpBitfieldFormat.Create;
  6654. Converter.RedMask := dwRBitMask;
  6655. Converter.GreenMask := dwGBitMask;
  6656. Converter.BlueMask := dwBBitMask;
  6657. Converter.AlphaMask := dwABitMask;
  6658. Converter.PixelSize := dwRGBBitCount / 8;
  6659. end;
  6660. end;
  6661. end;
  6662. var
  6663. StreamPos: Int64;
  6664. x, y, LineSize, RowSize, Magic: Cardinal;
  6665. NewImage, TmpData, RowData, SrcData: System.PByte;
  6666. SourceMD, DestMD: Pointer;
  6667. Pixel: TglBitmapPixelData;
  6668. ddsFormat: TglBitmapFormat;
  6669. FormatDesc: TFormatDescriptor;
  6670. begin
  6671. result := false;
  6672. Converter := nil;
  6673. StreamPos := aStream.Position;
  6674. // Magic
  6675. aStream.Read(Magic{%H-}, sizeof(Magic));
  6676. if (Magic <> DDS_MAGIC) then begin
  6677. aStream.Position := StreamPos;
  6678. exit;
  6679. end;
  6680. //Header
  6681. aStream.Read(Header{%H-}, sizeof(Header));
  6682. if (Header.dwSize <> SizeOf(Header)) or
  6683. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6684. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6685. begin
  6686. aStream.Position := StreamPos;
  6687. exit;
  6688. end;
  6689. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6690. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  6691. ddsFormat := GetDDSFormat;
  6692. try
  6693. if (ddsFormat = tfEmpty) then
  6694. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6695. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6696. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6697. GetMem(NewImage, Header.dwHeight * LineSize);
  6698. try
  6699. TmpData := NewImage;
  6700. //Converter needed
  6701. if Assigned(Converter) then begin
  6702. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6703. GetMem(RowData, RowSize);
  6704. SourceMD := Converter.CreateMappingData;
  6705. DestMD := FormatDesc.CreateMappingData;
  6706. try
  6707. for y := 0 to Header.dwHeight-1 do begin
  6708. TmpData := NewImage;
  6709. inc(TmpData, y * LineSize);
  6710. SrcData := RowData;
  6711. aStream.Read(SrcData^, RowSize);
  6712. for x := 0 to Header.dwWidth-1 do begin
  6713. Converter.Unmap(SrcData, Pixel, SourceMD);
  6714. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6715. FormatDesc.Map(Pixel, TmpData, DestMD);
  6716. end;
  6717. end;
  6718. finally
  6719. Converter.FreeMappingData(SourceMD);
  6720. FormatDesc.FreeMappingData(DestMD);
  6721. FreeMem(RowData);
  6722. end;
  6723. end else
  6724. // Compressed
  6725. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6726. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6727. for Y := 0 to Header.dwHeight-1 do begin
  6728. aStream.Read(TmpData^, RowSize);
  6729. Inc(TmpData, LineSize);
  6730. end;
  6731. end else
  6732. // Uncompressed
  6733. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6734. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6735. for Y := 0 to Header.dwHeight-1 do begin
  6736. aStream.Read(TmpData^, RowSize);
  6737. Inc(TmpData, LineSize);
  6738. end;
  6739. end else
  6740. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6741. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  6742. result := true;
  6743. except
  6744. if Assigned(NewImage) then
  6745. FreeMem(NewImage);
  6746. raise;
  6747. end;
  6748. finally
  6749. FreeAndNil(Converter);
  6750. end;
  6751. end;
  6752. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6753. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6754. var
  6755. Header: TDDSHeader;
  6756. FormatDesc: TFormatDescriptor;
  6757. begin
  6758. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6759. raise EglBitmapUnsupportedFormat.Create(Format);
  6760. FormatDesc := TFormatDescriptor.Get(Format);
  6761. // Generell
  6762. FillChar(Header{%H-}, SizeOf(Header), 0);
  6763. Header.dwSize := SizeOf(Header);
  6764. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6765. Header.dwWidth := Max(1, Width);
  6766. Header.dwHeight := Max(1, Height);
  6767. // Caps
  6768. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6769. // Pixelformat
  6770. Header.PixelFormat.dwSize := sizeof(Header);
  6771. if (FormatDesc.IsCompressed) then begin
  6772. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6773. case Format of
  6774. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6775. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6776. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6777. end;
  6778. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6779. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6780. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6781. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6782. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6783. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6784. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6785. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6786. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6787. end else begin
  6788. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6789. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6790. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6791. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6792. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6793. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6794. end;
  6795. if (FormatDesc.HasAlpha) then
  6796. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6797. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6798. aStream.Write(Header, SizeOf(Header));
  6799. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6800. end;
  6801. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6802. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6803. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6804. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6805. const aWidth: Integer; const aHeight: Integer);
  6806. var
  6807. pTemp: pByte;
  6808. Size: Integer;
  6809. begin
  6810. if (aHeight > 1) then begin
  6811. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  6812. GetMem(pTemp, Size);
  6813. try
  6814. Move(aData^, pTemp^, Size);
  6815. FreeMem(aData);
  6816. aData := nil;
  6817. except
  6818. FreeMem(pTemp);
  6819. raise;
  6820. end;
  6821. end else
  6822. pTemp := aData;
  6823. inherited SetDataPointer(pTemp, aFormat, aWidth);
  6824. end;
  6825. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6826. function TglBitmap1D.FlipHorz: Boolean;
  6827. var
  6828. Col: Integer;
  6829. pTempDest, pDest, pSource: PByte;
  6830. begin
  6831. result := inherited FlipHorz;
  6832. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  6833. pSource := Data;
  6834. GetMem(pDest, fRowSize);
  6835. try
  6836. pTempDest := pDest;
  6837. Inc(pTempDest, fRowSize);
  6838. for Col := 0 to Width-1 do begin
  6839. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  6840. Move(pSource^, pTempDest^, fPixelSize);
  6841. Inc(pSource, fPixelSize);
  6842. end;
  6843. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  6844. result := true;
  6845. except
  6846. if Assigned(pDest) then
  6847. FreeMem(pDest);
  6848. raise;
  6849. end;
  6850. end;
  6851. end;
  6852. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6853. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  6854. var
  6855. FormatDesc: TFormatDescriptor;
  6856. begin
  6857. // Upload data
  6858. FormatDesc := TFormatDescriptor.Get(Format);
  6859. if FormatDesc.IsCompressed then begin
  6860. if not Assigned(glCompressedTexImage1D) then
  6861. raise EglBitmap.Create('compressed formats not supported by video adapter');
  6862. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  6863. end else if aBuildWithGlu then
  6864. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6865. else
  6866. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6867. // Free Data
  6868. if (FreeDataAfterGenTexture) then
  6869. FreeData;
  6870. end;
  6871. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6872. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  6873. var
  6874. BuildWithGlu, TexRec: Boolean;
  6875. TexSize: Integer;
  6876. begin
  6877. if Assigned(Data) then begin
  6878. // Check Texture Size
  6879. if (aTestTextureSize) then begin
  6880. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6881. if (Width > TexSize) then
  6882. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6883. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6884. (Target = GL_TEXTURE_RECTANGLE);
  6885. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6886. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6887. end;
  6888. CreateId;
  6889. SetupParameters(BuildWithGlu);
  6890. UploadData(BuildWithGlu);
  6891. glAreTexturesResident(1, @fID, @fIsResident);
  6892. end;
  6893. end;
  6894. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6895. procedure TglBitmap1D.AfterConstruction;
  6896. begin
  6897. inherited;
  6898. Target := GL_TEXTURE_1D;
  6899. end;
  6900. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6901. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6903. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6904. begin
  6905. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6906. result := fLines[aIndex]
  6907. else
  6908. result := nil;
  6909. end;
  6910. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6911. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6912. const aWidth: Integer; const aHeight: Integer);
  6913. var
  6914. Idx, LineWidth: Integer;
  6915. begin
  6916. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6917. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6918. // Assigning Data
  6919. if Assigned(Data) then begin
  6920. SetLength(fLines, GetHeight);
  6921. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6922. for Idx := 0 to GetHeight-1 do begin
  6923. fLines[Idx] := Data;
  6924. Inc(fLines[Idx], Idx * LineWidth);
  6925. end;
  6926. end
  6927. else SetLength(fLines, 0);
  6928. end else begin
  6929. SetLength(fLines, 0);
  6930. end;
  6931. end;
  6932. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6933. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  6934. var
  6935. FormatDesc: TFormatDescriptor;
  6936. begin
  6937. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6938. FormatDesc := TFormatDescriptor.Get(Format);
  6939. if FormatDesc.IsCompressed then begin
  6940. if not Assigned(glCompressedTexImage2D) then
  6941. raise EglBitmap.Create('compressed formats not supported by video adapter');
  6942. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  6943. end else if aBuildWithGlu then begin
  6944. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  6945. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6946. end else begin
  6947. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  6948. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6949. end;
  6950. // Freigeben
  6951. if (FreeDataAfterGenTexture) then
  6952. FreeData;
  6953. end;
  6954. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6955. procedure TglBitmap2D.AfterConstruction;
  6956. begin
  6957. inherited;
  6958. Target := GL_TEXTURE_2D;
  6959. end;
  6960. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6961. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  6962. var
  6963. Temp: pByte;
  6964. Size, w, h: Integer;
  6965. FormatDesc: TFormatDescriptor;
  6966. begin
  6967. FormatDesc := TFormatDescriptor.Get(aFormat);
  6968. if FormatDesc.IsCompressed then
  6969. raise EglBitmapUnsupportedFormat.Create(aFormat);
  6970. w := aRight - aLeft;
  6971. h := aBottom - aTop;
  6972. Size := FormatDesc.GetSize(w, h);
  6973. GetMem(Temp, Size);
  6974. try
  6975. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  6976. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  6977. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  6978. FlipVert;
  6979. except
  6980. if Assigned(Temp) then
  6981. FreeMem(Temp);
  6982. raise;
  6983. end;
  6984. end;
  6985. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6986. procedure TglBitmap2D.GetDataFromTexture;
  6987. var
  6988. Temp: PByte;
  6989. TempWidth, TempHeight: Integer;
  6990. TempIntFormat: Cardinal;
  6991. IntFormat, f: TglBitmapFormat;
  6992. FormatDesc: TFormatDescriptor;
  6993. begin
  6994. Bind;
  6995. // Request Data
  6996. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  6997. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  6998. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  6999. IntFormat := tfEmpty;
  7000. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  7001. FormatDesc := TFormatDescriptor.Get(f);
  7002. if (FormatDesc.glInternalFormat = TempIntFormat) then begin
  7003. IntFormat := FormatDesc.Format;
  7004. break;
  7005. end;
  7006. end;
  7007. // Getting data from OpenGL
  7008. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7009. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7010. try
  7011. if FormatDesc.IsCompressed then begin
  7012. if not Assigned(glGetCompressedTexImage) then
  7013. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7014. glGetCompressedTexImage(Target, 0, Temp)
  7015. end else
  7016. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7017. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7018. except
  7019. if Assigned(Temp) then
  7020. FreeMem(Temp);
  7021. raise;
  7022. end;
  7023. end;
  7024. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7025. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7026. var
  7027. BuildWithGlu, PotTex, TexRec: Boolean;
  7028. TexSize: Integer;
  7029. begin
  7030. if Assigned(Data) then begin
  7031. // Check Texture Size
  7032. if (aTestTextureSize) then begin
  7033. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7034. if ((Height > TexSize) or (Width > TexSize)) then
  7035. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7036. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7037. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7038. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7039. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7040. end;
  7041. CreateId;
  7042. SetupParameters(BuildWithGlu);
  7043. UploadData(Target, BuildWithGlu);
  7044. glAreTexturesResident(1, @fID, @fIsResident);
  7045. end;
  7046. end;
  7047. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7048. function TglBitmap2D.FlipHorz: Boolean;
  7049. var
  7050. Col, Row: Integer;
  7051. TempDestData, DestData, SourceData: PByte;
  7052. ImgSize: Integer;
  7053. begin
  7054. result := inherited FlipHorz;
  7055. if Assigned(Data) then begin
  7056. SourceData := Data;
  7057. ImgSize := Height * fRowSize;
  7058. GetMem(DestData, ImgSize);
  7059. try
  7060. TempDestData := DestData;
  7061. Dec(TempDestData, fRowSize + fPixelSize);
  7062. for Row := 0 to Height -1 do begin
  7063. Inc(TempDestData, fRowSize * 2);
  7064. for Col := 0 to Width -1 do begin
  7065. Move(SourceData^, TempDestData^, fPixelSize);
  7066. Inc(SourceData, fPixelSize);
  7067. Dec(TempDestData, fPixelSize);
  7068. end;
  7069. end;
  7070. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  7071. result := true;
  7072. except
  7073. if Assigned(DestData) then
  7074. FreeMem(DestData);
  7075. raise;
  7076. end;
  7077. end;
  7078. end;
  7079. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7080. function TglBitmap2D.FlipVert: Boolean;
  7081. var
  7082. Row: Integer;
  7083. TempDestData, DestData, SourceData: PByte;
  7084. begin
  7085. result := inherited FlipVert;
  7086. if Assigned(Data) then begin
  7087. SourceData := Data;
  7088. GetMem(DestData, Height * fRowSize);
  7089. try
  7090. TempDestData := DestData;
  7091. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7092. for Row := 0 to Height -1 do begin
  7093. Move(SourceData^, TempDestData^, fRowSize);
  7094. Dec(TempDestData, fRowSize);
  7095. Inc(SourceData, fRowSize);
  7096. end;
  7097. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  7098. result := true;
  7099. except
  7100. if Assigned(DestData) then
  7101. FreeMem(DestData);
  7102. raise;
  7103. end;
  7104. end;
  7105. end;
  7106. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7107. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7108. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7109. type
  7110. TMatrixItem = record
  7111. X, Y: Integer;
  7112. W: Single;
  7113. end;
  7114. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7115. TglBitmapToNormalMapRec = Record
  7116. Scale: Single;
  7117. Heights: array of Single;
  7118. MatrixU : array of TMatrixItem;
  7119. MatrixV : array of TMatrixItem;
  7120. end;
  7121. const
  7122. ONE_OVER_255 = 1 / 255;
  7123. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7124. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7125. var
  7126. Val: Single;
  7127. begin
  7128. with FuncRec do begin
  7129. Val :=
  7130. Source.Data.r * LUMINANCE_WEIGHT_R +
  7131. Source.Data.g * LUMINANCE_WEIGHT_G +
  7132. Source.Data.b * LUMINANCE_WEIGHT_B;
  7133. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7134. end;
  7135. end;
  7136. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7137. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7138. begin
  7139. with FuncRec do
  7140. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7141. end;
  7142. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7143. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7144. type
  7145. TVec = Array[0..2] of Single;
  7146. var
  7147. Idx: Integer;
  7148. du, dv: Double;
  7149. Len: Single;
  7150. Vec: TVec;
  7151. function GetHeight(X, Y: Integer): Single;
  7152. begin
  7153. with FuncRec do begin
  7154. X := Max(0, Min(Size.X -1, X));
  7155. Y := Max(0, Min(Size.Y -1, Y));
  7156. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7157. end;
  7158. end;
  7159. begin
  7160. with FuncRec do begin
  7161. with PglBitmapToNormalMapRec(Args)^ do begin
  7162. du := 0;
  7163. for Idx := Low(MatrixU) to High(MatrixU) do
  7164. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7165. dv := 0;
  7166. for Idx := Low(MatrixU) to High(MatrixU) do
  7167. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7168. Vec[0] := -du * Scale;
  7169. Vec[1] := -dv * Scale;
  7170. Vec[2] := 1;
  7171. end;
  7172. // Normalize
  7173. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7174. if Len <> 0 then begin
  7175. Vec[0] := Vec[0] * Len;
  7176. Vec[1] := Vec[1] * Len;
  7177. Vec[2] := Vec[2] * Len;
  7178. end;
  7179. // Farbe zuweisem
  7180. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7181. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7182. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7183. end;
  7184. end;
  7185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7186. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7187. var
  7188. Rec: TglBitmapToNormalMapRec;
  7189. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7190. begin
  7191. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7192. Matrix[Index].X := X;
  7193. Matrix[Index].Y := Y;
  7194. Matrix[Index].W := W;
  7195. end;
  7196. end;
  7197. begin
  7198. if TFormatDescriptor.Get(Format).IsCompressed then
  7199. raise EglBitmapUnsupportedFormat.Create(Format);
  7200. if aScale > 100 then
  7201. Rec.Scale := 100
  7202. else if aScale < -100 then
  7203. Rec.Scale := -100
  7204. else
  7205. Rec.Scale := aScale;
  7206. SetLength(Rec.Heights, Width * Height);
  7207. try
  7208. case aFunc of
  7209. nm4Samples: begin
  7210. SetLength(Rec.MatrixU, 2);
  7211. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7212. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7213. SetLength(Rec.MatrixV, 2);
  7214. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7215. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7216. end;
  7217. nmSobel: begin
  7218. SetLength(Rec.MatrixU, 6);
  7219. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7220. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7221. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7222. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7223. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7224. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7225. SetLength(Rec.MatrixV, 6);
  7226. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7227. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7228. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7229. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7230. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7231. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7232. end;
  7233. nm3x3: begin
  7234. SetLength(Rec.MatrixU, 6);
  7235. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7236. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7237. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7238. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7239. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7240. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7241. SetLength(Rec.MatrixV, 6);
  7242. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7243. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7244. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7245. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7246. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7247. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7248. end;
  7249. nm5x5: begin
  7250. SetLength(Rec.MatrixU, 20);
  7251. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7252. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7253. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7254. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7255. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7256. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7257. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7258. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7259. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7260. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7261. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7262. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7263. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7264. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7265. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7266. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7267. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7268. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7269. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7270. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7271. SetLength(Rec.MatrixV, 20);
  7272. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7273. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7274. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7275. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7276. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7277. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7278. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7279. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7280. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7281. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7282. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7283. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7284. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7285. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7286. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7287. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7288. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7289. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7290. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7291. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7292. end;
  7293. end;
  7294. // Daten Sammeln
  7295. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7296. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7297. else
  7298. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7299. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7300. finally
  7301. SetLength(Rec.Heights, 0);
  7302. end;
  7303. end;
  7304. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7305. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7306. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7307. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7308. begin
  7309. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7310. end;
  7311. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7312. procedure TglBitmapCubeMap.AfterConstruction;
  7313. begin
  7314. inherited;
  7315. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7316. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7317. SetWrap;
  7318. Target := GL_TEXTURE_CUBE_MAP;
  7319. fGenMode := GL_REFLECTION_MAP;
  7320. end;
  7321. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7322. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7323. var
  7324. BuildWithGlu: Boolean;
  7325. TexSize: Integer;
  7326. begin
  7327. if (aTestTextureSize) then begin
  7328. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7329. if (Height > TexSize) or (Width > TexSize) then
  7330. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7331. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7332. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7333. end;
  7334. if (ID = 0) then
  7335. CreateID;
  7336. SetupParameters(BuildWithGlu);
  7337. UploadData(aCubeTarget, BuildWithGlu);
  7338. end;
  7339. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7340. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
  7341. begin
  7342. inherited Bind (aEnableTextureUnit);
  7343. if aEnableTexCoordsGen then begin
  7344. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7345. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7346. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7347. glEnable(GL_TEXTURE_GEN_S);
  7348. glEnable(GL_TEXTURE_GEN_T);
  7349. glEnable(GL_TEXTURE_GEN_R);
  7350. end;
  7351. end;
  7352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7353. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
  7354. begin
  7355. inherited Unbind(aDisableTextureUnit);
  7356. if aDisableTexCoordsGen then begin
  7357. glDisable(GL_TEXTURE_GEN_S);
  7358. glDisable(GL_TEXTURE_GEN_T);
  7359. glDisable(GL_TEXTURE_GEN_R);
  7360. end;
  7361. end;
  7362. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7363. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7365. type
  7366. TVec = Array[0..2] of Single;
  7367. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7368. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7369. TglBitmapNormalMapRec = record
  7370. HalfSize : Integer;
  7371. Func: TglBitmapNormalMapGetVectorFunc;
  7372. end;
  7373. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7374. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7375. begin
  7376. aVec[0] := aHalfSize;
  7377. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7378. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7379. end;
  7380. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7381. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7382. begin
  7383. aVec[0] := - aHalfSize;
  7384. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7385. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7386. end;
  7387. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7388. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7389. begin
  7390. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7391. aVec[1] := aHalfSize;
  7392. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7393. end;
  7394. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7395. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7396. begin
  7397. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7398. aVec[1] := - aHalfSize;
  7399. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7400. end;
  7401. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7402. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7403. begin
  7404. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7405. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7406. aVec[2] := aHalfSize;
  7407. end;
  7408. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7409. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7410. begin
  7411. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7412. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7413. aVec[2] := - aHalfSize;
  7414. end;
  7415. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7416. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7417. var
  7418. i: Integer;
  7419. Vec: TVec;
  7420. Len: Single;
  7421. begin
  7422. with FuncRec do begin
  7423. with PglBitmapNormalMapRec(Args)^ do begin
  7424. Func(Vec, Position, HalfSize);
  7425. // Normalize
  7426. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7427. if Len <> 0 then begin
  7428. Vec[0] := Vec[0] * Len;
  7429. Vec[1] := Vec[1] * Len;
  7430. Vec[2] := Vec[2] * Len;
  7431. end;
  7432. // Scale Vector and AddVectro
  7433. Vec[0] := Vec[0] * 0.5 + 0.5;
  7434. Vec[1] := Vec[1] * 0.5 + 0.5;
  7435. Vec[2] := Vec[2] * 0.5 + 0.5;
  7436. end;
  7437. // Set Color
  7438. for i := 0 to 2 do
  7439. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7440. end;
  7441. end;
  7442. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7443. procedure TglBitmapNormalMap.AfterConstruction;
  7444. begin
  7445. inherited;
  7446. fGenMode := GL_NORMAL_MAP;
  7447. end;
  7448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7449. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7450. var
  7451. Rec: TglBitmapNormalMapRec;
  7452. SizeRec: TglBitmapPixelPosition;
  7453. begin
  7454. Rec.HalfSize := aSize div 2;
  7455. FreeDataAfterGenTexture := false;
  7456. SizeRec.Fields := [ffX, ffY];
  7457. SizeRec.X := aSize;
  7458. SizeRec.Y := aSize;
  7459. // Positive X
  7460. Rec.Func := glBitmapNormalMapPosX;
  7461. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7462. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7463. // Negative X
  7464. Rec.Func := glBitmapNormalMapNegX;
  7465. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7466. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7467. // Positive Y
  7468. Rec.Func := glBitmapNormalMapPosY;
  7469. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7470. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7471. // Negative Y
  7472. Rec.Func := glBitmapNormalMapNegY;
  7473. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7474. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7475. // Positive Z
  7476. Rec.Func := glBitmapNormalMapPosZ;
  7477. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7478. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7479. // Negative Z
  7480. Rec.Func := glBitmapNormalMapNegZ;
  7481. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7482. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7483. end;
  7484. initialization
  7485. glBitmapSetDefaultFormat (tfEmpty);
  7486. glBitmapSetDefaultMipmap (mmMipmap);
  7487. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7488. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7489. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7490. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7491. glBitmapSetDefaultDeleteTextureOnFree (true);
  7492. TFormatDescriptor.Init;
  7493. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7494. OpenGLInitialized := false;
  7495. InitOpenGLCS := TCriticalSection.Create;
  7496. {$ENDIF}
  7497. finalization
  7498. TFormatDescriptor.Finalize;
  7499. {$IFDEF GLB_NATIVE_OGL}
  7500. if Assigned(GL_LibHandle) then
  7501. glbFreeLibrary(GL_LibHandle);
  7502. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7503. if Assigned(GLU_LibHandle) then
  7504. glbFreeLibrary(GLU_LibHandle);
  7505. FreeAndNil(InitOpenGLCS);
  7506. {$ENDIF}
  7507. {$ENDIF}
  7508. end.