You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

8531 lines
294 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)} windows, {$IFEND}
  393. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  394. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  395. {$IFDEF GLB_DELPHI} Dialogs, Graphics, {$ENDIF}
  396. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  397. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  398. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  399. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  400. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  401. Classes, SysUtils;
  402. {$IFDEF GLB_NATIVE_OGL}
  403. const
  404. GL_TRUE = 1;
  405. GL_FALSE = 0;
  406. GL_ZERO = 0;
  407. GL_ONE = 1;
  408. GL_VERSION = $1F02;
  409. GL_EXTENSIONS = $1F03;
  410. GL_TEXTURE_1D = $0DE0;
  411. GL_TEXTURE_2D = $0DE1;
  412. GL_TEXTURE_RECTANGLE = $84F5;
  413. GL_NORMAL_MAP = $8511;
  414. GL_TEXTURE_CUBE_MAP = $8513;
  415. GL_REFLECTION_MAP = $8512;
  416. GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
  417. GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
  418. GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
  419. GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
  420. GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
  421. GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
  422. GL_TEXTURE_WIDTH = $1000;
  423. GL_TEXTURE_HEIGHT = $1001;
  424. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  425. GL_TEXTURE_SWIZZLE_RGBA = $8E46;
  426. GL_S = $2000;
  427. GL_T = $2001;
  428. GL_R = $2002;
  429. GL_Q = $2003;
  430. GL_TEXTURE_GEN_S = $0C60;
  431. GL_TEXTURE_GEN_T = $0C61;
  432. GL_TEXTURE_GEN_R = $0C62;
  433. GL_TEXTURE_GEN_Q = $0C63;
  434. GL_RED = $1903;
  435. GL_GREEN = $1904;
  436. GL_BLUE = $1905;
  437. GL_ALPHA = $1906;
  438. GL_ALPHA4 = $803B;
  439. GL_ALPHA8 = $803C;
  440. GL_ALPHA12 = $803D;
  441. GL_ALPHA16 = $803E;
  442. GL_LUMINANCE = $1909;
  443. GL_LUMINANCE4 = $803F;
  444. GL_LUMINANCE8 = $8040;
  445. GL_LUMINANCE12 = $8041;
  446. GL_LUMINANCE16 = $8042;
  447. GL_LUMINANCE_ALPHA = $190A;
  448. GL_LUMINANCE4_ALPHA4 = $8043;
  449. GL_LUMINANCE6_ALPHA2 = $8044;
  450. GL_LUMINANCE8_ALPHA8 = $8045;
  451. GL_LUMINANCE12_ALPHA4 = $8046;
  452. GL_LUMINANCE12_ALPHA12 = $8047;
  453. GL_LUMINANCE16_ALPHA16 = $8048;
  454. GL_RGB = $1907;
  455. GL_BGR = $80E0;
  456. GL_R3_G3_B2 = $2A10;
  457. GL_RGB4 = $804F;
  458. GL_RGB5 = $8050;
  459. GL_RGB565 = $8D62;
  460. GL_RGB8 = $8051;
  461. GL_RGB10 = $8052;
  462. GL_RGB12 = $8053;
  463. GL_RGB16 = $8054;
  464. GL_RGBA = $1908;
  465. GL_BGRA = $80E1;
  466. GL_RGBA2 = $8055;
  467. GL_RGBA4 = $8056;
  468. GL_RGB5_A1 = $8057;
  469. GL_RGBA8 = $8058;
  470. GL_RGB10_A2 = $8059;
  471. GL_RGBA12 = $805A;
  472. GL_RGBA16 = $805B;
  473. GL_DEPTH_COMPONENT = $1902;
  474. GL_DEPTH_COMPONENT16 = $81A5;
  475. GL_DEPTH_COMPONENT24 = $81A6;
  476. GL_DEPTH_COMPONENT32 = $81A7;
  477. GL_COMPRESSED_RGB = $84ED;
  478. GL_COMPRESSED_RGBA = $84EE;
  479. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  480. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  481. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  482. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  483. GL_UNSIGNED_BYTE = $1401;
  484. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  485. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  486. GL_UNSIGNED_SHORT = $1403;
  487. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  488. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  489. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  490. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  491. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  492. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  493. GL_UNSIGNED_INT = $1405;
  494. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  495. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  496. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  497. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  498. { Texture Filter }
  499. GL_TEXTURE_MAG_FILTER = $2800;
  500. GL_TEXTURE_MIN_FILTER = $2801;
  501. GL_NEAREST = $2600;
  502. GL_NEAREST_MIPMAP_NEAREST = $2700;
  503. GL_NEAREST_MIPMAP_LINEAR = $2702;
  504. GL_LINEAR = $2601;
  505. GL_LINEAR_MIPMAP_NEAREST = $2701;
  506. GL_LINEAR_MIPMAP_LINEAR = $2703;
  507. { Texture Wrap }
  508. GL_TEXTURE_WRAP_S = $2802;
  509. GL_TEXTURE_WRAP_T = $2803;
  510. GL_TEXTURE_WRAP_R = $8072;
  511. GL_CLAMP = $2900;
  512. GL_REPEAT = $2901;
  513. GL_CLAMP_TO_EDGE = $812F;
  514. GL_CLAMP_TO_BORDER = $812D;
  515. GL_MIRRORED_REPEAT = $8370;
  516. { Other }
  517. GL_GENERATE_MIPMAP = $8191;
  518. GL_TEXTURE_BORDER_COLOR = $1004;
  519. GL_MAX_TEXTURE_SIZE = $0D33;
  520. GL_PACK_ALIGNMENT = $0D05;
  521. GL_UNPACK_ALIGNMENT = $0CF5;
  522. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  523. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  524. GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
  525. GL_TEXTURE_GEN_MODE = $2500;
  526. {$IF DEFINED(GLB_WIN)}
  527. libglu = 'glu32.dll';
  528. libopengl = 'opengl32.dll';
  529. {$ELSEIF DEFINED(GLB_LINUX)}
  530. libglu = 'libGLU.so.1';
  531. libopengl = 'libGL.so.1';
  532. {$IFEND}
  533. type
  534. GLboolean = BYTEBOOL;
  535. GLint = Integer;
  536. GLsizei = Integer;
  537. GLuint = Cardinal;
  538. GLfloat = Single;
  539. GLenum = Cardinal;
  540. PGLvoid = Pointer;
  541. PGLboolean = ^GLboolean;
  542. PGLint = ^GLint;
  543. PGLuint = ^GLuint;
  544. PGLfloat = ^GLfloat;
  545. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  546. 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}
  547. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  548. {$IF DEFINED(GLB_WIN)}
  549. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  550. {$ELSEIF DEFINED(GLB_LINUX)}
  551. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  552. TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
  553. {$IFEND}
  554. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  555. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  556. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  557. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  558. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  559. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  560. TglTexParameteriv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  561. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  562. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  563. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  564. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  565. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  566. TglTexGeni = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  567. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  568. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  569. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  570. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  571. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  572. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  573. 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}
  574. 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}
  575. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  576. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  577. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  578. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  579. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  580. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  581. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  582. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  583. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  584. procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  585. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  586. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  587. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  588. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  589. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  590. procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  591. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  592. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  593. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  594. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  595. 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;
  596. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  597. 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;
  598. 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;
  599. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  600. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  601. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  602. {$IFEND}
  603. var
  604. GL_VERSION_1_2,
  605. GL_VERSION_1_3,
  606. GL_VERSION_1_4,
  607. GL_VERSION_2_0,
  608. GL_VERSION_3_3,
  609. GL_SGIS_generate_mipmap,
  610. GL_ARB_texture_border_clamp,
  611. GL_ARB_texture_mirrored_repeat,
  612. GL_ARB_texture_rectangle,
  613. GL_ARB_texture_non_power_of_two,
  614. GL_ARB_texture_swizzle,
  615. GL_ARB_texture_cube_map,
  616. GL_IBM_texture_mirrored_repeat,
  617. GL_NV_texture_rectangle,
  618. GL_EXT_texture_edge_clamp,
  619. GL_EXT_texture_rectangle,
  620. GL_EXT_texture_swizzle,
  621. GL_EXT_texture_cube_map,
  622. GL_EXT_texture_filter_anisotropic: Boolean;
  623. glCompressedTexImage1D: TglCompressedTexImage1D;
  624. glCompressedTexImage2D: TglCompressedTexImage2D;
  625. glGetCompressedTexImage: TglGetCompressedTexImage;
  626. {$IF DEFINED(GLB_WIN)}
  627. wglGetProcAddress: TwglGetProcAddress;
  628. {$ELSEIF DEFINED(GLB_LINUX)}
  629. glXGetProcAddress: TglXGetProcAddress;
  630. glXGetProcAddressARB: TglXGetProcAddress;
  631. {$IFEND}
  632. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  633. glEnable: TglEnable;
  634. glDisable: TglDisable;
  635. glGetString: TglGetString;
  636. glGetIntegerv: TglGetIntegerv;
  637. glTexParameteri: TglTexParameteri;
  638. glTexParameteriv: TglTexParameteriv;
  639. glTexParameterfv: TglTexParameterfv;
  640. glGetTexParameteriv: TglGetTexParameteriv;
  641. glGetTexParameterfv: TglGetTexParameterfv;
  642. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  643. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  644. glTexGeni: TglTexGeni;
  645. glGenTextures: TglGenTextures;
  646. glBindTexture: TglBindTexture;
  647. glDeleteTextures: TglDeleteTextures;
  648. glAreTexturesResident: TglAreTexturesResident;
  649. glReadPixels: TglReadPixels;
  650. glPixelStorei: TglPixelStorei;
  651. glTexImage1D: TglTexImage1D;
  652. glTexImage2D: TglTexImage2D;
  653. glGetTexImage: TglGetTexImage;
  654. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  655. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  656. {$ENDIF}
  657. {$ENDIF}
  658. type
  659. ////////////////////////////////////////////////////////////////////////////////////////////////////
  660. TglBitmapFormat = (
  661. tfEmpty = 0, //must be smallest value!
  662. tfAlpha4,
  663. tfAlpha8,
  664. tfAlpha12,
  665. tfAlpha16,
  666. tfLuminance4,
  667. tfLuminance8,
  668. tfLuminance12,
  669. tfLuminance16,
  670. tfLuminance4Alpha4,
  671. tfLuminance6Alpha2,
  672. tfLuminance8Alpha8,
  673. tfLuminance12Alpha4,
  674. tfLuminance12Alpha12,
  675. tfLuminance16Alpha16,
  676. tfR3G3B2,
  677. tfRGB4,
  678. tfR5G6B5,
  679. tfRGB5,
  680. tfRGB8,
  681. tfRGB10,
  682. tfRGB12,
  683. tfRGB16,
  684. tfRGBA2,
  685. tfRGBA4,
  686. tfRGB5A1,
  687. tfRGBA8,
  688. tfRGB10A2,
  689. tfRGBA12,
  690. tfRGBA16,
  691. tfBGR4,
  692. tfB5G6R5,
  693. tfBGR5,
  694. tfBGR8,
  695. tfBGR10,
  696. tfBGR12,
  697. tfBGR16,
  698. tfBGRA2,
  699. tfBGRA4,
  700. tfBGR5A1,
  701. tfBGRA8,
  702. tfBGR10A2,
  703. tfBGRA12,
  704. tfBGRA16,
  705. tfDepth16,
  706. tfDepth24,
  707. tfDepth32,
  708. tfS3tcDtx1RGBA,
  709. tfS3tcDtx3RGBA,
  710. tfS3tcDtx5RGBA
  711. );
  712. TglBitmapFileType = (
  713. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  714. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  715. ftDDS,
  716. ftTGA,
  717. ftBMP);
  718. TglBitmapFileTypes = set of TglBitmapFileType;
  719. TglBitmapMipMap = (
  720. mmNone,
  721. mmMipmap,
  722. mmMipmapGlu);
  723. TglBitmapNormalMapFunc = (
  724. nm4Samples,
  725. nmSobel,
  726. nm3x3,
  727. nm5x5);
  728. ////////////////////////////////////////////////////////////////////////////////////////////////////
  729. EglBitmap = class(Exception);
  730. EglBitmapNotSupported = class(Exception);
  731. EglBitmapSizeToLarge = class(EglBitmap);
  732. EglBitmapNonPowerOfTwo = class(EglBitmap);
  733. EglBitmapUnsupportedFormat = class(EglBitmap)
  734. constructor Create(const aFormat: TglBitmapFormat); overload;
  735. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  736. end;
  737. ////////////////////////////////////////////////////////////////////////////////////////////////////
  738. TglBitmapColorRec = packed record
  739. case Integer of
  740. 0: (r, g, b, a: Cardinal);
  741. 1: (arr: array[0..3] of Cardinal);
  742. end;
  743. TglBitmapPixelData = packed record
  744. Data, Range: TglBitmapColorRec;
  745. Format: TglBitmapFormat;
  746. end;
  747. PglBitmapPixelData = ^TglBitmapPixelData;
  748. ////////////////////////////////////////////////////////////////////////////////////////////////////
  749. TglBitmapPixelPositionFields = set of (ffX, ffY);
  750. TglBitmapPixelPosition = record
  751. Fields : TglBitmapPixelPositionFields;
  752. X : Word;
  753. Y : Word;
  754. end;
  755. TglBitmapFormatDescriptor = class(TObject)
  756. protected
  757. function GetIsCompressed: Boolean; virtual; abstract;
  758. function GetHasAlpha: Boolean; virtual; abstract;
  759. function GetglDataFormat: GLenum; virtual; abstract;
  760. function GetglFormat: GLenum; virtual; abstract;
  761. function GetglInternalFormat: GLenum; virtual; abstract;
  762. public
  763. property IsCompressed: Boolean read GetIsCompressed;
  764. property HasAlpha: Boolean read GetHasAlpha;
  765. property glFormat: GLenum read GetglFormat;
  766. property glInternalFormat: GLenum read GetglInternalFormat;
  767. property glDataFormat: GLenum read GetglDataFormat;
  768. end;
  769. ////////////////////////////////////////////////////////////////////////////////////////////////////
  770. TglBitmap = class;
  771. TglBitmapFunctionRec = record
  772. Sender: TglBitmap;
  773. Size: TglBitmapPixelPosition;
  774. Position: TglBitmapPixelPosition;
  775. Source: TglBitmapPixelData;
  776. Dest: TglBitmapPixelData;
  777. Args: Pointer;
  778. end;
  779. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  780. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  781. TglBitmap = class
  782. private
  783. function GetFormatDesc: TglBitmapFormatDescriptor;
  784. protected
  785. fID: GLuint;
  786. fTarget: GLuint;
  787. fAnisotropic: Integer;
  788. fDeleteTextureOnFree: Boolean;
  789. fFreeDataAfterGenTexture: Boolean;
  790. fData: PByte;
  791. fIsResident: Boolean;
  792. fBorderColor: array[0..3] of Single;
  793. fDimension: TglBitmapPixelPosition;
  794. fMipMap: TglBitmapMipMap;
  795. fFormat: TglBitmapFormat;
  796. // Mapping
  797. fPixelSize: Integer;
  798. fRowSize: Integer;
  799. // Filtering
  800. fFilterMin: GLenum;
  801. fFilterMag: GLenum;
  802. // TexturWarp
  803. fWrapS: GLenum;
  804. fWrapT: GLenum;
  805. fWrapR: GLenum;
  806. //Swizzle
  807. fSwizzle: array[0..3] of GLenum;
  808. // CustomData
  809. fFilename: String;
  810. fCustomName: String;
  811. fCustomNameW: WideString;
  812. fCustomData: Pointer;
  813. //Getter
  814. function GetWidth: Integer; virtual;
  815. function GetHeight: Integer; virtual;
  816. function GetFileWidth: Integer; virtual;
  817. function GetFileHeight: Integer; virtual;
  818. //Setter
  819. procedure SetCustomData(const aValue: Pointer);
  820. procedure SetCustomName(const aValue: String);
  821. procedure SetCustomNameW(const aValue: WideString);
  822. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  823. procedure SetFormat(const aValue: TglBitmapFormat);
  824. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  825. procedure SetID(const aValue: Cardinal);
  826. procedure SetMipMap(const aValue: TglBitmapMipMap);
  827. procedure SetTarget(const aValue: Cardinal);
  828. procedure SetAnisotropic(const aValue: Integer);
  829. procedure CreateID;
  830. procedure SetupParameters(out aBuildWithGlu: Boolean);
  831. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  832. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method
  833. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  834. function FlipHorz: Boolean; virtual;
  835. function FlipVert: Boolean; virtual;
  836. property Width: Integer read GetWidth;
  837. property Height: Integer read GetHeight;
  838. property FileWidth: Integer read GetFileWidth;
  839. property FileHeight: Integer read GetFileHeight;
  840. public
  841. //Properties
  842. property ID: Cardinal read fID write SetID;
  843. property Target: Cardinal read fTarget write SetTarget;
  844. property Format: TglBitmapFormat read fFormat write SetFormat;
  845. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  846. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  847. property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc;
  848. property Filename: String read fFilename;
  849. property CustomName: String read fCustomName write SetCustomName;
  850. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  851. property CustomData: Pointer read fCustomData write SetCustomData;
  852. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  853. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  854. property Dimension: TglBitmapPixelPosition read fDimension;
  855. property Data: PByte read fData;
  856. property IsResident: Boolean read fIsResident;
  857. procedure AfterConstruction; override;
  858. procedure BeforeDestruction; override;
  859. procedure PrepareResType(var aResource: String; var aResType: PChar);
  860. //Load
  861. procedure LoadFromFile(const aFilename: String);
  862. procedure LoadFromStream(const aStream: TStream); virtual;
  863. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  864. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  865. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  866. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  867. //Save
  868. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  869. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  870. //Convert
  871. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  872. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  873. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  874. public
  875. //Alpha & Co
  876. {$IFDEF GLB_SDL}
  877. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  878. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  879. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  880. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  881. const aArgs: Pointer = nil): Boolean;
  882. {$ENDIF}
  883. {$IFDEF GLB_DELPHI}
  884. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  885. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  886. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  887. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  888. const aArgs: Pointer = nil): Boolean;
  889. {$ENDIF}
  890. {$IFDEF GLB_LAZARUS}
  891. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  892. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  893. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  894. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  895. const aArgs: Pointer = nil): Boolean;
  896. {$ENDIF}
  897. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  898. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  899. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  900. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  901. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  902. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  903. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  904. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  905. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  906. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  907. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  908. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  909. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  910. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  911. function RemoveAlpha: Boolean; virtual;
  912. public
  913. //Common
  914. function Clone: TglBitmap;
  915. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  916. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  917. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  918. procedure FreeData;
  919. //ColorFill
  920. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  921. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  922. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  923. //TexParameters
  924. procedure SetFilter(const aMin, aMag: GLenum);
  925. procedure SetWrap(
  926. const S: GLenum = GL_CLAMP_TO_EDGE;
  927. const T: GLenum = GL_CLAMP_TO_EDGE;
  928. const R: GLenum = GL_CLAMP_TO_EDGE);
  929. procedure SetSwizzle(const r, g, b, a: GLenum);
  930. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  931. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  932. //Constructors
  933. constructor Create; overload;
  934. constructor Create(const aFileName: String); overload;
  935. constructor Create(const aStream: TStream); overload;
  936. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
  937. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  938. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  939. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  940. private
  941. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  942. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  943. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  944. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  945. function LoadBMP(const aStream: TStream): Boolean; virtual;
  946. procedure SaveBMP(const aStream: TStream); virtual;
  947. function LoadTGA(const aStream: TStream): Boolean; virtual;
  948. procedure SaveTGA(const aStream: TStream); virtual;
  949. function LoadDDS(const aStream: TStream): Boolean; virtual;
  950. procedure SaveDDS(const aStream: TStream); virtual;
  951. end;
  952. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  953. TglBitmap1D = class(TglBitmap)
  954. protected
  955. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  956. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  957. procedure UploadData(const aBuildWithGlu: Boolean);
  958. public
  959. property Width;
  960. procedure AfterConstruction; override;
  961. function FlipHorz: Boolean; override;
  962. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  963. end;
  964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  965. TglBitmap2D = class(TglBitmap)
  966. protected
  967. fLines: array of PByte;
  968. function GetScanline(const aIndex: Integer): Pointer;
  969. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  970. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  971. procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  972. public
  973. property Width;
  974. property Height;
  975. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  976. procedure AfterConstruction; override;
  977. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  978. procedure GetDataFromTexture;
  979. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  980. function FlipHorz: Boolean; override;
  981. function FlipVert: Boolean; override;
  982. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  983. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  984. end;
  985. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  986. TglBitmapCubeMap = class(TglBitmap2D)
  987. protected
  988. fGenMode: Integer;
  989. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  990. public
  991. procedure AfterConstruction; override;
  992. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  993. procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  994. procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  995. end;
  996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  997. TglBitmapNormalMap = class(TglBitmapCubeMap)
  998. public
  999. procedure AfterConstruction; override;
  1000. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  1001. end;
  1002. const
  1003. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1004. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1005. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1006. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1007. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1008. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1009. procedure glBitmapSetDefaultWrap(
  1010. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1011. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1012. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1013. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1014. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1015. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1016. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1017. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1018. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1019. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1020. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1021. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1022. var
  1023. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1024. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1025. glBitmapDefaultFormat: TglBitmapFormat;
  1026. glBitmapDefaultMipmap: TglBitmapMipMap;
  1027. glBitmapDefaultFilterMin: Cardinal;
  1028. glBitmapDefaultFilterMag: Cardinal;
  1029. glBitmapDefaultWrapS: Cardinal;
  1030. glBitmapDefaultWrapT: Cardinal;
  1031. glBitmapDefaultWrapR: Cardinal;
  1032. glDefaultSwizzle: array[0..3] of GLenum;
  1033. {$IFDEF GLB_DELPHI}
  1034. function CreateGrayPalette: HPALETTE;
  1035. {$ENDIF}
  1036. implementation
  1037. uses
  1038. Math, syncobjs, typinfo;
  1039. type
  1040. {$IFNDEF fpc}
  1041. QWord = System.UInt64;
  1042. PQWord = ^QWord;
  1043. PtrInt = Longint;
  1044. PtrUInt = DWord;
  1045. {$ENDIF}
  1046. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1047. TShiftRec = packed record
  1048. case Integer of
  1049. 0: (r, g, b, a: Byte);
  1050. 1: (arr: array[0..3] of Byte);
  1051. end;
  1052. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1053. private
  1054. function GetRedMask: QWord;
  1055. function GetGreenMask: QWord;
  1056. function GetBlueMask: QWord;
  1057. function GetAlphaMask: QWord;
  1058. protected
  1059. fFormat: TglBitmapFormat;
  1060. fWithAlpha: TglBitmapFormat;
  1061. fWithoutAlpha: TglBitmapFormat;
  1062. fRGBInverted: TglBitmapFormat;
  1063. fUncompressed: TglBitmapFormat;
  1064. fPixelSize: Single;
  1065. fIsCompressed: Boolean;
  1066. fRange: TglBitmapColorRec;
  1067. fShift: TShiftRec;
  1068. fglFormat: GLenum;
  1069. fglInternalFormat: GLenum;
  1070. fglDataFormat: GLenum;
  1071. function GetIsCompressed: Boolean; override;
  1072. function GetHasAlpha: Boolean; override;
  1073. function GetglFormat: GLenum; override;
  1074. function GetglInternalFormat: GLenum; override;
  1075. function GetglDataFormat: GLenum; override;
  1076. function GetComponents: Integer; virtual;
  1077. public
  1078. property Format: TglBitmapFormat read fFormat;
  1079. property WithAlpha: TglBitmapFormat read fWithAlpha;
  1080. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  1081. property RGBInverted: TglBitmapFormat read fRGBInverted;
  1082. property Components: Integer read GetComponents;
  1083. property PixelSize: Single read fPixelSize;
  1084. property Range: TglBitmapColorRec read fRange;
  1085. property Shift: TShiftRec read fShift;
  1086. property RedMask: QWord read GetRedMask;
  1087. property GreenMask: QWord read GetGreenMask;
  1088. property BlueMask: QWord read GetBlueMask;
  1089. property AlphaMask: QWord read GetAlphaMask;
  1090. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1091. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1092. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1093. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1094. function CreateMappingData: Pointer; virtual;
  1095. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1096. function IsEmpty: Boolean; virtual;
  1097. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  1098. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1099. constructor Create; virtual;
  1100. public
  1101. class procedure Init;
  1102. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1103. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1104. class procedure Clear;
  1105. class procedure Finalize;
  1106. end;
  1107. TFormatDescriptorClass = class of TFormatDescriptor;
  1108. TfdEmpty = class(TFormatDescriptor);
  1109. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1110. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1111. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1112. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1113. constructor Create; override;
  1114. end;
  1115. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1116. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1117. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1118. constructor Create; override;
  1119. end;
  1120. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1121. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1122. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1123. constructor Create; override;
  1124. end;
  1125. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1126. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1127. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1128. constructor Create; override;
  1129. end;
  1130. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1131. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1132. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1133. constructor Create; override;
  1134. end;
  1135. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1136. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1137. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1138. constructor Create; override;
  1139. end;
  1140. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1141. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1142. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1143. constructor Create; override;
  1144. end;
  1145. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1146. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1147. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1148. constructor Create; override;
  1149. end;
  1150. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1151. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  1152. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1153. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1154. constructor Create; override;
  1155. end;
  1156. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  1157. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1158. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1159. constructor Create; override;
  1160. end;
  1161. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1162. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1163. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1164. constructor Create; override;
  1165. end;
  1166. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1167. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1168. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1169. constructor Create; override;
  1170. end;
  1171. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1172. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1173. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1174. constructor Create; override;
  1175. end;
  1176. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1177. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1178. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1179. constructor Create; override;
  1180. end;
  1181. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1182. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1183. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1184. constructor Create; override;
  1185. end;
  1186. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1187. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1188. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1189. constructor Create; override;
  1190. end;
  1191. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1192. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1193. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1194. constructor Create; override;
  1195. end;
  1196. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1197. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  1198. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1199. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1200. constructor Create; override;
  1201. end;
  1202. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1203. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1204. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1205. constructor Create; override;
  1206. end;
  1207. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1208. TfdAlpha4 = class(TfdAlpha_UB1)
  1209. constructor Create; override;
  1210. end;
  1211. TfdAlpha8 = class(TfdAlpha_UB1)
  1212. constructor Create; override;
  1213. end;
  1214. TfdAlpha12 = class(TfdAlpha_US1)
  1215. constructor Create; override;
  1216. end;
  1217. TfdAlpha16 = class(TfdAlpha_US1)
  1218. constructor Create; override;
  1219. end;
  1220. TfdLuminance4 = class(TfdLuminance_UB1)
  1221. constructor Create; override;
  1222. end;
  1223. TfdLuminance8 = class(TfdLuminance_UB1)
  1224. constructor Create; override;
  1225. end;
  1226. TfdLuminance12 = class(TfdLuminance_US1)
  1227. constructor Create; override;
  1228. end;
  1229. TfdLuminance16 = class(TfdLuminance_US1)
  1230. constructor Create; override;
  1231. end;
  1232. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1233. constructor Create; override;
  1234. end;
  1235. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1236. constructor Create; override;
  1237. end;
  1238. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1239. constructor Create; override;
  1240. end;
  1241. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1242. constructor Create; override;
  1243. end;
  1244. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1245. constructor Create; override;
  1246. end;
  1247. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1248. constructor Create; override;
  1249. end;
  1250. TfdR3G3B2 = class(TfdUniversal_UB1)
  1251. constructor Create; override;
  1252. end;
  1253. TfdRGB4 = class(TfdUniversal_US1)
  1254. constructor Create; override;
  1255. end;
  1256. TfdR5G6B5 = class(TfdUniversal_US1)
  1257. constructor Create; override;
  1258. end;
  1259. TfdRGB5 = class(TfdUniversal_US1)
  1260. constructor Create; override;
  1261. end;
  1262. TfdRGB8 = class(TfdRGB_UB3)
  1263. constructor Create; override;
  1264. end;
  1265. TfdRGB10 = class(TfdUniversal_UI1)
  1266. constructor Create; override;
  1267. end;
  1268. TfdRGB12 = class(TfdRGB_US3)
  1269. constructor Create; override;
  1270. end;
  1271. TfdRGB16 = class(TfdRGB_US3)
  1272. constructor Create; override;
  1273. end;
  1274. TfdRGBA2 = class(TfdRGBA_UB4)
  1275. constructor Create; override;
  1276. end;
  1277. TfdRGBA4 = class(TfdUniversal_US1)
  1278. constructor Create; override;
  1279. end;
  1280. TfdRGB5A1 = class(TfdUniversal_US1)
  1281. constructor Create; override;
  1282. end;
  1283. TfdRGBA8 = class(TfdRGBA_UB4)
  1284. constructor Create; override;
  1285. end;
  1286. TfdRGB10A2 = class(TfdUniversal_UI1)
  1287. constructor Create; override;
  1288. end;
  1289. TfdRGBA12 = class(TfdRGBA_US4)
  1290. constructor Create; override;
  1291. end;
  1292. TfdRGBA16 = class(TfdRGBA_US4)
  1293. constructor Create; override;
  1294. end;
  1295. TfdBGR4 = class(TfdUniversal_US1)
  1296. constructor Create; override;
  1297. end;
  1298. TfdB5G6R5 = class(TfdUniversal_US1)
  1299. constructor Create; override;
  1300. end;
  1301. TfdBGR5 = class(TfdUniversal_US1)
  1302. constructor Create; override;
  1303. end;
  1304. TfdBGR8 = class(TfdBGR_UB3)
  1305. constructor Create; override;
  1306. end;
  1307. TfdBGR10 = class(TfdUniversal_UI1)
  1308. constructor Create; override;
  1309. end;
  1310. TfdBGR12 = class(TfdBGR_US3)
  1311. constructor Create; override;
  1312. end;
  1313. TfdBGR16 = class(TfdBGR_US3)
  1314. constructor Create; override;
  1315. end;
  1316. TfdBGRA2 = class(TfdBGRA_UB4)
  1317. constructor Create; override;
  1318. end;
  1319. TfdBGRA4 = class(TfdUniversal_US1)
  1320. constructor Create; override;
  1321. end;
  1322. TfdBGR5A1 = class(TfdUniversal_US1)
  1323. constructor Create; override;
  1324. end;
  1325. TfdBGRA8 = class(TfdBGRA_UB4)
  1326. constructor Create; override;
  1327. end;
  1328. TfdBGR10A2 = class(TfdUniversal_UI1)
  1329. constructor Create; override;
  1330. end;
  1331. TfdBGRA12 = class(TfdBGRA_US4)
  1332. constructor Create; override;
  1333. end;
  1334. TfdBGRA16 = class(TfdBGRA_US4)
  1335. constructor Create; override;
  1336. end;
  1337. TfdDepth16 = class(TfdDepth_US1)
  1338. constructor Create; override;
  1339. end;
  1340. TfdDepth24 = class(TfdDepth_UI1)
  1341. constructor Create; override;
  1342. end;
  1343. TfdDepth32 = class(TfdDepth_UI1)
  1344. constructor Create; override;
  1345. end;
  1346. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1347. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1348. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1349. constructor Create; override;
  1350. end;
  1351. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1352. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1353. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1354. constructor Create; override;
  1355. end;
  1356. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1357. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1358. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1359. constructor Create; override;
  1360. end;
  1361. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1362. TbmpBitfieldFormat = class(TFormatDescriptor)
  1363. private
  1364. procedure SetRedMask (const aValue: QWord);
  1365. procedure SetGreenMask(const aValue: QWord);
  1366. procedure SetBlueMask (const aValue: QWord);
  1367. procedure SetAlphaMask(const aValue: QWord);
  1368. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1369. public
  1370. property RedMask: QWord read GetRedMask write SetRedMask;
  1371. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1372. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1373. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1374. property PixelSize: Single read fPixelSize write fPixelSize;
  1375. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1376. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1377. end;
  1378. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1379. TbmpColorTableEnty = packed record
  1380. b, g, r, a: Byte;
  1381. end;
  1382. TbmpColorTable = array of TbmpColorTableEnty;
  1383. TbmpColorTableFormat = class(TFormatDescriptor)
  1384. private
  1385. fColorTable: TbmpColorTable;
  1386. public
  1387. property PixelSize: Single read fPixelSize write fPixelSize;
  1388. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1389. property Range: TglBitmapColorRec read fRange write fRange;
  1390. property Shift: TShiftRec read fShift write fShift;
  1391. property Format: TglBitmapFormat read fFormat write fFormat;
  1392. procedure CreateColorTable;
  1393. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1394. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1395. destructor Destroy; override;
  1396. end;
  1397. const
  1398. LUMINANCE_WEIGHT_R = 0.30;
  1399. LUMINANCE_WEIGHT_G = 0.59;
  1400. LUMINANCE_WEIGHT_B = 0.11;
  1401. ALPHA_WEIGHT_R = 0.30;
  1402. ALPHA_WEIGHT_G = 0.59;
  1403. ALPHA_WEIGHT_B = 0.11;
  1404. DEPTH_WEIGHT_R = 0.333333333;
  1405. DEPTH_WEIGHT_G = 0.333333333;
  1406. DEPTH_WEIGHT_B = 0.333333333;
  1407. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1408. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1409. TfdEmpty,
  1410. TfdAlpha4,
  1411. TfdAlpha8,
  1412. TfdAlpha12,
  1413. TfdAlpha16,
  1414. TfdLuminance4,
  1415. TfdLuminance8,
  1416. TfdLuminance12,
  1417. TfdLuminance16,
  1418. TfdLuminance4Alpha4,
  1419. TfdLuminance6Alpha2,
  1420. TfdLuminance8Alpha8,
  1421. TfdLuminance12Alpha4,
  1422. TfdLuminance12Alpha12,
  1423. TfdLuminance16Alpha16,
  1424. TfdR3G3B2,
  1425. TfdRGB4,
  1426. TfdR5G6B5,
  1427. TfdRGB5,
  1428. TfdRGB8,
  1429. TfdRGB10,
  1430. TfdRGB12,
  1431. TfdRGB16,
  1432. TfdRGBA2,
  1433. TfdRGBA4,
  1434. TfdRGB5A1,
  1435. TfdRGBA8,
  1436. TfdRGB10A2,
  1437. TfdRGBA12,
  1438. TfdRGBA16,
  1439. TfdBGR4,
  1440. TfdB5G6R5,
  1441. TfdBGR5,
  1442. TfdBGR8,
  1443. TfdBGR10,
  1444. TfdBGR12,
  1445. TfdBGR16,
  1446. TfdBGRA2,
  1447. TfdBGRA4,
  1448. TfdBGR5A1,
  1449. TfdBGRA8,
  1450. TfdBGR10A2,
  1451. TfdBGRA12,
  1452. TfdBGRA16,
  1453. TfdDepth16,
  1454. TfdDepth24,
  1455. TfdDepth32,
  1456. TfdS3tcDtx1RGBA,
  1457. TfdS3tcDtx3RGBA,
  1458. TfdS3tcDtx5RGBA
  1459. );
  1460. var
  1461. FormatDescriptorCS: TCriticalSection;
  1462. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1464. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1465. begin
  1466. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1467. end;
  1468. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1469. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1470. begin
  1471. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1472. end;
  1473. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1474. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1475. begin
  1476. result.Fields := [];
  1477. if X >= 0 then
  1478. result.Fields := result.Fields + [ffX];
  1479. if Y >= 0 then
  1480. result.Fields := result.Fields + [ffY];
  1481. result.X := Max(0, X);
  1482. result.Y := Max(0, Y);
  1483. end;
  1484. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1485. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1486. begin
  1487. result.r := r;
  1488. result.g := g;
  1489. result.b := b;
  1490. result.a := a;
  1491. end;
  1492. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1493. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1494. var
  1495. i: Integer;
  1496. begin
  1497. result := false;
  1498. for i := 0 to high(r1.arr) do
  1499. if (r1.arr[i] <> r2.arr[i]) then
  1500. exit;
  1501. result := true;
  1502. end;
  1503. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1504. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1505. begin
  1506. result.r := r;
  1507. result.g := g;
  1508. result.b := b;
  1509. result.a := a;
  1510. end;
  1511. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1512. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1513. begin
  1514. result := [];
  1515. if (aFormat in [
  1516. //4 bbp
  1517. tfLuminance4,
  1518. //8bpp
  1519. tfR3G3B2, tfLuminance8,
  1520. //16bpp
  1521. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1522. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1523. //24bpp
  1524. tfBGR8, tfRGB8,
  1525. //32bpp
  1526. tfRGB10, tfRGB10A2, tfRGBA8,
  1527. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1528. result := result + [ftBMP];
  1529. if (aFormat in [
  1530. //8 bpp
  1531. tfLuminance8, tfAlpha8,
  1532. //16 bpp
  1533. tfLuminance16, tfLuminance8Alpha8,
  1534. tfRGB5, tfRGB5A1, tfRGBA4,
  1535. tfBGR5, tfBGR5A1, tfBGRA4,
  1536. //24 bpp
  1537. tfRGB8, tfBGR8,
  1538. //32 bpp
  1539. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1540. result := result + [ftTGA];
  1541. if (aFormat in [
  1542. //8 bpp
  1543. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1544. tfR3G3B2, tfRGBA2, tfBGRA2,
  1545. //16 bpp
  1546. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1547. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1548. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1549. //24 bpp
  1550. tfRGB8, tfBGR8,
  1551. //32 bbp
  1552. tfLuminance16Alpha16,
  1553. tfRGBA8, tfRGB10A2,
  1554. tfBGRA8, tfBGR10A2,
  1555. //compressed
  1556. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1557. result := result + [ftDDS];
  1558. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1559. if aFormat in [
  1560. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1561. tfRGB8, tfRGBA8,
  1562. tfBGR8, tfBGRA8] then
  1563. result := result + [ftPNG];
  1564. {$ENDIF}
  1565. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1566. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1567. result := result + [ftJPEG];
  1568. {$ENDIF}
  1569. end;
  1570. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1571. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1572. begin
  1573. while (aNumber and 1) = 0 do
  1574. aNumber := aNumber shr 1;
  1575. result := aNumber = 1;
  1576. end;
  1577. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1578. function GetTopMostBit(aBitSet: QWord): Integer;
  1579. begin
  1580. result := 0;
  1581. while aBitSet > 0 do begin
  1582. inc(result);
  1583. aBitSet := aBitSet shr 1;
  1584. end;
  1585. end;
  1586. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1587. function CountSetBits(aBitSet: QWord): Integer;
  1588. begin
  1589. result := 0;
  1590. while aBitSet > 0 do begin
  1591. if (aBitSet and 1) = 1 then
  1592. inc(result);
  1593. aBitSet := aBitSet shr 1;
  1594. end;
  1595. end;
  1596. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1597. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1598. begin
  1599. result := Trunc(
  1600. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1601. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1602. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1603. end;
  1604. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1605. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1606. begin
  1607. result := Trunc(
  1608. DEPTH_WEIGHT_R * aPixel.Data.r +
  1609. DEPTH_WEIGHT_G * aPixel.Data.g +
  1610. DEPTH_WEIGHT_B * aPixel.Data.b);
  1611. end;
  1612. {$IFDEF GLB_NATIVE_OGL}
  1613. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1614. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1615. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1616. var
  1617. GL_LibHandle: Pointer = nil;
  1618. function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
  1619. begin
  1620. if not Assigned(aLibHandle) then
  1621. aLibHandle := GL_LibHandle;
  1622. {$IF DEFINED(GLB_WIN)}
  1623. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1624. if Assigned(result) then
  1625. exit;
  1626. if Assigned(wglGetProcAddress) then
  1627. result := wglGetProcAddress(aProcName);
  1628. {$ELSEIF DEFINED(GLB_LINUX)}
  1629. if Assigned(glXGetProcAddress) then begin
  1630. result := glXGetProcAddress(aProcName);
  1631. if Assigned(result) then
  1632. exit;
  1633. end;
  1634. if Assigned(glXGetProcAddressARB) then begin
  1635. result := glXGetProcAddressARB(aProcName);
  1636. if Assigned(result) then
  1637. exit;
  1638. end;
  1639. result := dlsym(aLibHandle, aProcName);
  1640. {$IFEND}
  1641. if not Assigned(result) then
  1642. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1643. end;
  1644. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1645. var
  1646. GLU_LibHandle: Pointer = nil;
  1647. OpenGLInitialized: Boolean;
  1648. InitOpenGLCS: TCriticalSection;
  1649. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1650. procedure glbInitOpenGL;
  1651. ////////////////////////////////////////////////////////////////////////////////
  1652. function glbLoadLibrary(const aName: PChar): Pointer;
  1653. begin
  1654. {$IF DEFINED(GLB_WIN)}
  1655. result := {%H-}Pointer(LoadLibrary(aName));
  1656. {$ELSEIF DEFINED(GLB_LINUX)}
  1657. result := dlopen(Name, RTLD_LAZY);
  1658. {$ELSE}
  1659. result := nil;
  1660. {$IFEND}
  1661. end;
  1662. ////////////////////////////////////////////////////////////////////////////////
  1663. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1664. begin
  1665. result := false;
  1666. if not Assigned(aLibHandle) then
  1667. exit;
  1668. {$IF DEFINED(GLB_WIN)}
  1669. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1670. {$ELSEIF DEFINED(GLB_LINUX)}
  1671. Result := dlclose(aLibHandle) = 0;
  1672. {$IFEND}
  1673. end;
  1674. begin
  1675. if Assigned(GL_LibHandle) then
  1676. glbFreeLibrary(GL_LibHandle);
  1677. if Assigned(GLU_LibHandle) then
  1678. glbFreeLibrary(GLU_LibHandle);
  1679. GL_LibHandle := glbLoadLibrary(libopengl);
  1680. if not Assigned(GL_LibHandle) then
  1681. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1682. GLU_LibHandle := glbLoadLibrary(libglu);
  1683. if not Assigned(GLU_LibHandle) then
  1684. raise EglBitmap.Create('unable to load library: ' + libglu);
  1685. try
  1686. {$IF DEFINED(GLB_WIN)}
  1687. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1688. {$ELSEIF DEFINED(GLB_LINUX)}
  1689. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1690. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1691. {$IFEND}
  1692. glEnable := glbGetProcAddress('glEnable');
  1693. glDisable := glbGetProcAddress('glDisable');
  1694. glGetString := glbGetProcAddress('glGetString');
  1695. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1696. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1697. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1698. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1699. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1700. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1701. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1702. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1703. glTexGeni := glbGetProcAddress('glTexGeni');
  1704. glGenTextures := glbGetProcAddress('glGenTextures');
  1705. glBindTexture := glbGetProcAddress('glBindTexture');
  1706. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1707. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1708. glReadPixels := glbGetProcAddress('glReadPixels');
  1709. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1710. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1711. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1712. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1713. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1714. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1715. finally
  1716. glbFreeLibrary(GL_LibHandle);
  1717. glbFreeLibrary(GLU_LibHandle);
  1718. end;
  1719. end;
  1720. {$ENDIF}
  1721. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1722. procedure glbReadOpenGLExtensions;
  1723. var
  1724. Buffer: AnsiString;
  1725. MajorVersion, MinorVersion: Integer;
  1726. ///////////////////////////////////////////////////////////////////////////////////////////
  1727. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1728. var
  1729. Separator: Integer;
  1730. begin
  1731. aMinor := 0;
  1732. aMajor := 0;
  1733. Separator := Pos(AnsiString('.'), aBuffer);
  1734. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1735. (aBuffer[Separator - 1] in ['0'..'9']) and
  1736. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1737. Dec(Separator);
  1738. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1739. Dec(Separator);
  1740. Delete(aBuffer, 1, Separator);
  1741. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1742. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1743. Inc(Separator);
  1744. Delete(aBuffer, Separator, 255);
  1745. Separator := Pos(AnsiString('.'), aBuffer);
  1746. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1747. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1748. end;
  1749. end;
  1750. ///////////////////////////////////////////////////////////////////////////////////////////
  1751. function CheckExtension(const Extension: AnsiString): Boolean;
  1752. var
  1753. ExtPos: Integer;
  1754. begin
  1755. ExtPos := Pos(Extension, Buffer);
  1756. result := ExtPos > 0;
  1757. if result then
  1758. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1759. end;
  1760. ///////////////////////////////////////////////////////////////////////////////////////////
  1761. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1762. begin
  1763. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1764. end;
  1765. begin
  1766. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1767. InitOpenGLCS.Enter;
  1768. try
  1769. if not OpenGLInitialized then begin
  1770. glbInitOpenGL;
  1771. OpenGLInitialized := true;
  1772. end;
  1773. finally
  1774. InitOpenGLCS.Leave;
  1775. end;
  1776. {$ENDIF}
  1777. // Version
  1778. Buffer := glGetString(GL_VERSION);
  1779. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1780. GL_VERSION_1_2 := CheckVersion(1, 2);
  1781. GL_VERSION_1_3 := CheckVersion(1, 3);
  1782. GL_VERSION_1_4 := CheckVersion(1, 4);
  1783. GL_VERSION_2_0 := CheckVersion(2, 0);
  1784. GL_VERSION_3_3 := CheckVersion(3, 3);
  1785. // Extensions
  1786. Buffer := glGetString(GL_EXTENSIONS);
  1787. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1788. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1789. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1790. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1791. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1792. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1793. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1794. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1795. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1796. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1797. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1798. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1799. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1800. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1801. if GL_VERSION_1_3 then begin
  1802. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1803. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1804. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1805. end else begin
  1806. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB');
  1807. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB');
  1808. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
  1809. end;
  1810. end;
  1811. {$ENDIF}
  1812. {$IFDEF GLB_SDL_IMAGE}
  1813. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1814. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1815. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1816. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1817. begin
  1818. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1819. end;
  1820. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1821. begin
  1822. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1823. end;
  1824. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1825. begin
  1826. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1827. end;
  1828. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1829. begin
  1830. result := 0;
  1831. end;
  1832. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1833. begin
  1834. result := SDL_AllocRW;
  1835. if result = nil then
  1836. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1837. result^.seek := glBitmapRWseek;
  1838. result^.read := glBitmapRWread;
  1839. result^.write := glBitmapRWwrite;
  1840. result^.close := glBitmapRWclose;
  1841. result^.unknown.data1 := Stream;
  1842. end;
  1843. {$ENDIF}
  1844. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1845. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1846. begin
  1847. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1848. end;
  1849. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1850. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1851. begin
  1852. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1853. end;
  1854. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1855. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1856. begin
  1857. glBitmapDefaultMipmap := aValue;
  1858. end;
  1859. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1860. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1861. begin
  1862. glBitmapDefaultFormat := aFormat;
  1863. end;
  1864. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1865. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1866. begin
  1867. glBitmapDefaultFilterMin := aMin;
  1868. glBitmapDefaultFilterMag := aMag;
  1869. end;
  1870. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1871. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1872. begin
  1873. glBitmapDefaultWrapS := S;
  1874. glBitmapDefaultWrapT := T;
  1875. glBitmapDefaultWrapR := R;
  1876. end;
  1877. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1878. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1879. begin
  1880. glDefaultSwizzle[0] := r;
  1881. glDefaultSwizzle[1] := g;
  1882. glDefaultSwizzle[2] := b;
  1883. glDefaultSwizzle[3] := a;
  1884. end;
  1885. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1886. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1887. begin
  1888. result := glBitmapDefaultDeleteTextureOnFree;
  1889. end;
  1890. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1891. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1892. begin
  1893. result := glBitmapDefaultFreeDataAfterGenTextures;
  1894. end;
  1895. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1896. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1897. begin
  1898. result := glBitmapDefaultMipmap;
  1899. end;
  1900. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1901. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1902. begin
  1903. result := glBitmapDefaultFormat;
  1904. end;
  1905. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1906. procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
  1907. begin
  1908. aMin := glBitmapDefaultFilterMin;
  1909. aMag := glBitmapDefaultFilterMag;
  1910. end;
  1911. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1912. procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
  1913. begin
  1914. S := glBitmapDefaultWrapS;
  1915. T := glBitmapDefaultWrapT;
  1916. R := glBitmapDefaultWrapR;
  1917. end;
  1918. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1919. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1920. begin
  1921. r := glDefaultSwizzle[0];
  1922. g := glDefaultSwizzle[1];
  1923. b := glDefaultSwizzle[2];
  1924. a := glDefaultSwizzle[3];
  1925. end;
  1926. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1927. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1928. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1929. function TFormatDescriptor.GetRedMask: QWord;
  1930. begin
  1931. result := fRange.r shl fShift.r;
  1932. end;
  1933. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1934. function TFormatDescriptor.GetGreenMask: QWord;
  1935. begin
  1936. result := fRange.g shl fShift.g;
  1937. end;
  1938. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1939. function TFormatDescriptor.GetBlueMask: QWord;
  1940. begin
  1941. result := fRange.b shl fShift.b;
  1942. end;
  1943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1944. function TFormatDescriptor.GetAlphaMask: QWord;
  1945. begin
  1946. result := fRange.a shl fShift.a;
  1947. end;
  1948. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1949. function TFormatDescriptor.GetIsCompressed: Boolean;
  1950. begin
  1951. result := fIsCompressed;
  1952. end;
  1953. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1954. function TFormatDescriptor.GetHasAlpha: Boolean;
  1955. begin
  1956. result := (fRange.a > 0);
  1957. end;
  1958. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1959. function TFormatDescriptor.GetglFormat: GLenum;
  1960. begin
  1961. result := fglFormat;
  1962. end;
  1963. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1964. function TFormatDescriptor.GetglInternalFormat: GLenum;
  1965. begin
  1966. result := fglInternalFormat;
  1967. end;
  1968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1969. function TFormatDescriptor.GetglDataFormat: GLenum;
  1970. begin
  1971. result := fglDataFormat;
  1972. end;
  1973. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1974. function TFormatDescriptor.GetComponents: Integer;
  1975. var
  1976. i: Integer;
  1977. begin
  1978. result := 0;
  1979. for i := 0 to 3 do
  1980. if (fRange.arr[i] > 0) then
  1981. inc(result);
  1982. end;
  1983. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1984. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  1985. var
  1986. w, h: Integer;
  1987. begin
  1988. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  1989. w := Max(1, aSize.X);
  1990. h := Max(1, aSize.Y);
  1991. result := GetSize(w, h);
  1992. end else
  1993. result := 0;
  1994. end;
  1995. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1996. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  1997. begin
  1998. result := 0;
  1999. if (aWidth <= 0) or (aHeight <= 0) then
  2000. exit;
  2001. result := Ceil(aWidth * aHeight * fPixelSize);
  2002. end;
  2003. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2004. function TFormatDescriptor.CreateMappingData: Pointer;
  2005. begin
  2006. result := nil;
  2007. end;
  2008. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2009. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2010. begin
  2011. //DUMMY
  2012. end;
  2013. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2014. function TFormatDescriptor.IsEmpty: Boolean;
  2015. begin
  2016. result := (fFormat = tfEmpty);
  2017. end;
  2018. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2019. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  2020. begin
  2021. result := false;
  2022. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2023. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2024. if (aRedMask <> RedMask) then
  2025. exit;
  2026. if (aGreenMask <> GreenMask) then
  2027. exit;
  2028. if (aBlueMask <> BlueMask) then
  2029. exit;
  2030. if (aAlphaMask <> AlphaMask) then
  2031. exit;
  2032. result := true;
  2033. end;
  2034. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2035. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2036. begin
  2037. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2038. aPixel.Data := fRange;
  2039. aPixel.Range := fRange;
  2040. aPixel.Format := fFormat;
  2041. end;
  2042. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2043. constructor TFormatDescriptor.Create;
  2044. begin
  2045. inherited Create;
  2046. fFormat := tfEmpty;
  2047. fWithAlpha := tfEmpty;
  2048. fWithoutAlpha := tfEmpty;
  2049. fRGBInverted := tfEmpty;
  2050. fUncompressed := tfEmpty;
  2051. fPixelSize := 0.0;
  2052. fIsCompressed := false;
  2053. fglFormat := 0;
  2054. fglInternalFormat := 0;
  2055. fglDataFormat := 0;
  2056. FillChar(fRange, 0, SizeOf(fRange));
  2057. FillChar(fShift, 0, SizeOf(fShift));
  2058. end;
  2059. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2060. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2061. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2062. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2063. begin
  2064. aData^ := aPixel.Data.a;
  2065. inc(aData);
  2066. end;
  2067. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2068. begin
  2069. aPixel.Data.r := 0;
  2070. aPixel.Data.g := 0;
  2071. aPixel.Data.b := 0;
  2072. aPixel.Data.a := aData^;
  2073. inc(aData);
  2074. end;
  2075. constructor TfdAlpha_UB1.Create;
  2076. begin
  2077. inherited Create;
  2078. fPixelSize := 1.0;
  2079. fRange.a := $FF;
  2080. fglFormat := GL_ALPHA;
  2081. fglDataFormat := GL_UNSIGNED_BYTE;
  2082. end;
  2083. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2084. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2085. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2086. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2087. begin
  2088. aData^ := LuminanceWeight(aPixel);
  2089. inc(aData);
  2090. end;
  2091. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2092. begin
  2093. aPixel.Data.r := aData^;
  2094. aPixel.Data.g := aData^;
  2095. aPixel.Data.b := aData^;
  2096. aPixel.Data.a := 0;
  2097. inc(aData);
  2098. end;
  2099. constructor TfdLuminance_UB1.Create;
  2100. begin
  2101. inherited Create;
  2102. fPixelSize := 1.0;
  2103. fRange.r := $FF;
  2104. fRange.g := $FF;
  2105. fRange.b := $FF;
  2106. fglFormat := GL_LUMINANCE;
  2107. fglDataFormat := GL_UNSIGNED_BYTE;
  2108. end;
  2109. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2110. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2112. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2113. var
  2114. i: Integer;
  2115. begin
  2116. aData^ := 0;
  2117. for i := 0 to 3 do
  2118. if (fRange.arr[i] > 0) then
  2119. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2120. inc(aData);
  2121. end;
  2122. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2123. var
  2124. i: Integer;
  2125. begin
  2126. for i := 0 to 3 do
  2127. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2128. inc(aData);
  2129. end;
  2130. constructor TfdUniversal_UB1.Create;
  2131. begin
  2132. inherited Create;
  2133. fPixelSize := 1.0;
  2134. end;
  2135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2136. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2138. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2139. begin
  2140. inherited Map(aPixel, aData, aMapData);
  2141. aData^ := aPixel.Data.a;
  2142. inc(aData);
  2143. end;
  2144. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2145. begin
  2146. inherited Unmap(aData, aPixel, aMapData);
  2147. aPixel.Data.a := aData^;
  2148. inc(aData);
  2149. end;
  2150. constructor TfdLuminanceAlpha_UB2.Create;
  2151. begin
  2152. inherited Create;
  2153. fPixelSize := 2.0;
  2154. fRange.a := $FF;
  2155. fShift.a := 8;
  2156. fglFormat := GL_LUMINANCE_ALPHA;
  2157. fglDataFormat := GL_UNSIGNED_BYTE;
  2158. end;
  2159. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2160. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2161. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2162. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2163. begin
  2164. aData^ := aPixel.Data.r;
  2165. inc(aData);
  2166. aData^ := aPixel.Data.g;
  2167. inc(aData);
  2168. aData^ := aPixel.Data.b;
  2169. inc(aData);
  2170. end;
  2171. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2172. begin
  2173. aPixel.Data.r := aData^;
  2174. inc(aData);
  2175. aPixel.Data.g := aData^;
  2176. inc(aData);
  2177. aPixel.Data.b := aData^;
  2178. inc(aData);
  2179. aPixel.Data.a := 0;
  2180. end;
  2181. constructor TfdRGB_UB3.Create;
  2182. begin
  2183. inherited Create;
  2184. fPixelSize := 3.0;
  2185. fRange.r := $FF;
  2186. fRange.g := $FF;
  2187. fRange.b := $FF;
  2188. fShift.r := 0;
  2189. fShift.g := 8;
  2190. fShift.b := 16;
  2191. fglFormat := GL_RGB;
  2192. fglDataFormat := GL_UNSIGNED_BYTE;
  2193. end;
  2194. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2195. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2196. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2197. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2198. begin
  2199. aData^ := aPixel.Data.b;
  2200. inc(aData);
  2201. aData^ := aPixel.Data.g;
  2202. inc(aData);
  2203. aData^ := aPixel.Data.r;
  2204. inc(aData);
  2205. end;
  2206. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2207. begin
  2208. aPixel.Data.b := aData^;
  2209. inc(aData);
  2210. aPixel.Data.g := aData^;
  2211. inc(aData);
  2212. aPixel.Data.r := aData^;
  2213. inc(aData);
  2214. aPixel.Data.a := 0;
  2215. end;
  2216. constructor TfdBGR_UB3.Create;
  2217. begin
  2218. fPixelSize := 3.0;
  2219. fRange.r := $FF;
  2220. fRange.g := $FF;
  2221. fRange.b := $FF;
  2222. fShift.r := 16;
  2223. fShift.g := 8;
  2224. fShift.b := 0;
  2225. fglFormat := GL_BGR;
  2226. fglDataFormat := GL_UNSIGNED_BYTE;
  2227. end;
  2228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2229. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2230. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2231. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2232. begin
  2233. inherited Map(aPixel, aData, aMapData);
  2234. aData^ := aPixel.Data.a;
  2235. inc(aData);
  2236. end;
  2237. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2238. begin
  2239. inherited Unmap(aData, aPixel, aMapData);
  2240. aPixel.Data.a := aData^;
  2241. inc(aData);
  2242. end;
  2243. constructor TfdRGBA_UB4.Create;
  2244. begin
  2245. inherited Create;
  2246. fPixelSize := 4.0;
  2247. fRange.a := $FF;
  2248. fShift.a := 24;
  2249. fglFormat := GL_RGBA;
  2250. fglDataFormat := GL_UNSIGNED_BYTE;
  2251. end;
  2252. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2253. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2254. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2255. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2256. begin
  2257. inherited Map(aPixel, aData, aMapData);
  2258. aData^ := aPixel.Data.a;
  2259. inc(aData);
  2260. end;
  2261. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2262. begin
  2263. inherited Unmap(aData, aPixel, aMapData);
  2264. aPixel.Data.a := aData^;
  2265. inc(aData);
  2266. end;
  2267. constructor TfdBGRA_UB4.Create;
  2268. begin
  2269. inherited Create;
  2270. fPixelSize := 4.0;
  2271. fRange.a := $FF;
  2272. fShift.a := 24;
  2273. fglFormat := GL_BGRA;
  2274. fglDataFormat := GL_UNSIGNED_BYTE;
  2275. end;
  2276. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2277. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2279. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2280. begin
  2281. PWord(aData)^ := aPixel.Data.a;
  2282. inc(aData, 2);
  2283. end;
  2284. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2285. begin
  2286. aPixel.Data.r := 0;
  2287. aPixel.Data.g := 0;
  2288. aPixel.Data.b := 0;
  2289. aPixel.Data.a := PWord(aData)^;
  2290. inc(aData, 2);
  2291. end;
  2292. constructor TfdAlpha_US1.Create;
  2293. begin
  2294. inherited Create;
  2295. fPixelSize := 2.0;
  2296. fRange.a := $FFFF;
  2297. fglFormat := GL_ALPHA;
  2298. fglDataFormat := GL_UNSIGNED_SHORT;
  2299. end;
  2300. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2301. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2302. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2303. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2304. begin
  2305. PWord(aData)^ := LuminanceWeight(aPixel);
  2306. inc(aData, 2);
  2307. end;
  2308. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2309. begin
  2310. aPixel.Data.r := PWord(aData)^;
  2311. aPixel.Data.g := PWord(aData)^;
  2312. aPixel.Data.b := PWord(aData)^;
  2313. aPixel.Data.a := 0;
  2314. inc(aData, 2);
  2315. end;
  2316. constructor TfdLuminance_US1.Create;
  2317. begin
  2318. inherited Create;
  2319. fPixelSize := 2.0;
  2320. fRange.r := $FFFF;
  2321. fRange.g := $FFFF;
  2322. fRange.b := $FFFF;
  2323. fglFormat := GL_LUMINANCE;
  2324. fglDataFormat := GL_UNSIGNED_SHORT;
  2325. end;
  2326. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2327. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2328. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2329. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2330. var
  2331. i: Integer;
  2332. begin
  2333. PWord(aData)^ := 0;
  2334. for i := 0 to 3 do
  2335. if (fRange.arr[i] > 0) then
  2336. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2337. inc(aData, 2);
  2338. end;
  2339. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2340. var
  2341. i: Integer;
  2342. begin
  2343. for i := 0 to 3 do
  2344. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2345. inc(aData, 2);
  2346. end;
  2347. constructor TfdUniversal_US1.Create;
  2348. begin
  2349. inherited Create;
  2350. fPixelSize := 2.0;
  2351. end;
  2352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2353. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2354. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2355. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2356. begin
  2357. PWord(aData)^ := DepthWeight(aPixel);
  2358. inc(aData, 2);
  2359. end;
  2360. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2361. begin
  2362. aPixel.Data.r := PWord(aData)^;
  2363. aPixel.Data.g := PWord(aData)^;
  2364. aPixel.Data.b := PWord(aData)^;
  2365. aPixel.Data.a := 0;
  2366. inc(aData, 2);
  2367. end;
  2368. constructor TfdDepth_US1.Create;
  2369. begin
  2370. inherited Create;
  2371. fPixelSize := 2.0;
  2372. fRange.r := $FFFF;
  2373. fRange.g := $FFFF;
  2374. fRange.b := $FFFF;
  2375. fglFormat := GL_DEPTH_COMPONENT;
  2376. fglDataFormat := GL_UNSIGNED_SHORT;
  2377. end;
  2378. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2379. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2380. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2381. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2382. begin
  2383. inherited Map(aPixel, aData, aMapData);
  2384. PWord(aData)^ := aPixel.Data.a;
  2385. inc(aData, 2);
  2386. end;
  2387. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2388. begin
  2389. inherited Unmap(aData, aPixel, aMapData);
  2390. aPixel.Data.a := PWord(aData)^;
  2391. inc(aData, 2);
  2392. end;
  2393. constructor TfdLuminanceAlpha_US2.Create;
  2394. begin
  2395. inherited Create;
  2396. fPixelSize := 4.0;
  2397. fRange.a := $FFFF;
  2398. fShift.a := 16;
  2399. fglFormat := GL_LUMINANCE_ALPHA;
  2400. fglDataFormat := GL_UNSIGNED_SHORT;
  2401. end;
  2402. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2403. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2404. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2405. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2406. begin
  2407. PWord(aData)^ := aPixel.Data.r;
  2408. inc(aData, 2);
  2409. PWord(aData)^ := aPixel.Data.g;
  2410. inc(aData, 2);
  2411. PWord(aData)^ := aPixel.Data.b;
  2412. inc(aData, 2);
  2413. end;
  2414. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2415. begin
  2416. aPixel.Data.r := PWord(aData)^;
  2417. inc(aData, 2);
  2418. aPixel.Data.g := PWord(aData)^;
  2419. inc(aData, 2);
  2420. aPixel.Data.b := PWord(aData)^;
  2421. inc(aData, 2);
  2422. aPixel.Data.a := 0;
  2423. end;
  2424. constructor TfdRGB_US3.Create;
  2425. begin
  2426. inherited Create;
  2427. fPixelSize := 6.0;
  2428. fRange.r := $FFFF;
  2429. fRange.g := $FFFF;
  2430. fRange.b := $FFFF;
  2431. fShift.r := 0;
  2432. fShift.g := 16;
  2433. fShift.b := 32;
  2434. fglFormat := GL_RGB;
  2435. fglDataFormat := GL_UNSIGNED_SHORT;
  2436. end;
  2437. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2438. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2439. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2440. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2441. begin
  2442. PWord(aData)^ := aPixel.Data.b;
  2443. inc(aData, 2);
  2444. PWord(aData)^ := aPixel.Data.g;
  2445. inc(aData, 2);
  2446. PWord(aData)^ := aPixel.Data.r;
  2447. inc(aData, 2);
  2448. end;
  2449. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2450. begin
  2451. aPixel.Data.b := PWord(aData)^;
  2452. inc(aData, 2);
  2453. aPixel.Data.g := PWord(aData)^;
  2454. inc(aData, 2);
  2455. aPixel.Data.r := PWord(aData)^;
  2456. inc(aData, 2);
  2457. aPixel.Data.a := 0;
  2458. end;
  2459. constructor TfdBGR_US3.Create;
  2460. begin
  2461. inherited Create;
  2462. fPixelSize := 6.0;
  2463. fRange.r := $FFFF;
  2464. fRange.g := $FFFF;
  2465. fRange.b := $FFFF;
  2466. fShift.r := 32;
  2467. fShift.g := 16;
  2468. fShift.b := 0;
  2469. fglFormat := GL_BGR;
  2470. fglDataFormat := GL_UNSIGNED_SHORT;
  2471. end;
  2472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2473. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2475. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2476. begin
  2477. inherited Map(aPixel, aData, aMapData);
  2478. PWord(aData)^ := aPixel.Data.a;
  2479. inc(aData, 2);
  2480. end;
  2481. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2482. begin
  2483. inherited Unmap(aData, aPixel, aMapData);
  2484. aPixel.Data.a := PWord(aData)^;
  2485. inc(aData, 2);
  2486. end;
  2487. constructor TfdRGBA_US4.Create;
  2488. begin
  2489. inherited Create;
  2490. fPixelSize := 8.0;
  2491. fRange.a := $FFFF;
  2492. fShift.a := 48;
  2493. fglFormat := GL_RGBA;
  2494. fglDataFormat := GL_UNSIGNED_SHORT;
  2495. end;
  2496. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2497. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2498. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2499. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2500. begin
  2501. inherited Map(aPixel, aData, aMapData);
  2502. PWord(aData)^ := aPixel.Data.a;
  2503. inc(aData, 2);
  2504. end;
  2505. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2506. begin
  2507. inherited Unmap(aData, aPixel, aMapData);
  2508. aPixel.Data.a := PWord(aData)^;
  2509. inc(aData, 2);
  2510. end;
  2511. constructor TfdBGRA_US4.Create;
  2512. begin
  2513. inherited Create;
  2514. fPixelSize := 8.0;
  2515. fRange.a := $FFFF;
  2516. fShift.a := 48;
  2517. fglFormat := GL_BGRA;
  2518. fglDataFormat := GL_UNSIGNED_SHORT;
  2519. end;
  2520. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2521. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2522. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2523. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2524. var
  2525. i: Integer;
  2526. begin
  2527. PCardinal(aData)^ := 0;
  2528. for i := 0 to 3 do
  2529. if (fRange.arr[i] > 0) then
  2530. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2531. inc(aData, 4);
  2532. end;
  2533. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2534. var
  2535. i: Integer;
  2536. begin
  2537. for i := 0 to 3 do
  2538. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2539. inc(aData, 2);
  2540. end;
  2541. constructor TfdUniversal_UI1.Create;
  2542. begin
  2543. inherited Create;
  2544. fPixelSize := 4.0;
  2545. end;
  2546. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2547. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2548. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2549. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2550. begin
  2551. PCardinal(aData)^ := DepthWeight(aPixel);
  2552. inc(aData, 4);
  2553. end;
  2554. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2555. begin
  2556. aPixel.Data.r := PCardinal(aData)^;
  2557. aPixel.Data.g := PCardinal(aData)^;
  2558. aPixel.Data.b := PCardinal(aData)^;
  2559. aPixel.Data.a := 0;
  2560. inc(aData, 4);
  2561. end;
  2562. constructor TfdDepth_UI1.Create;
  2563. begin
  2564. inherited Create;
  2565. fPixelSize := 4.0;
  2566. fRange.r := $FFFFFFFF;
  2567. fRange.g := $FFFFFFFF;
  2568. fRange.b := $FFFFFFFF;
  2569. fglFormat := GL_DEPTH_COMPONENT;
  2570. fglDataFormat := GL_UNSIGNED_INT;
  2571. end;
  2572. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2574. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2575. constructor TfdAlpha4.Create;
  2576. begin
  2577. inherited Create;
  2578. fFormat := tfAlpha4;
  2579. fWithAlpha := tfAlpha4;
  2580. fglInternalFormat := GL_ALPHA4;
  2581. end;
  2582. constructor TfdAlpha8.Create;
  2583. begin
  2584. inherited Create;
  2585. fFormat := tfAlpha8;
  2586. fWithAlpha := tfAlpha8;
  2587. fglInternalFormat := GL_ALPHA8;
  2588. end;
  2589. constructor TfdAlpha12.Create;
  2590. begin
  2591. inherited Create;
  2592. fFormat := tfAlpha12;
  2593. fWithAlpha := tfAlpha12;
  2594. fglInternalFormat := GL_ALPHA12;
  2595. end;
  2596. constructor TfdAlpha16.Create;
  2597. begin
  2598. inherited Create;
  2599. fFormat := tfAlpha16;
  2600. fWithAlpha := tfAlpha16;
  2601. fglInternalFormat := GL_ALPHA16;
  2602. end;
  2603. constructor TfdLuminance4.Create;
  2604. begin
  2605. inherited Create;
  2606. fFormat := tfLuminance4;
  2607. fWithAlpha := tfLuminance4Alpha4;
  2608. fWithoutAlpha := tfLuminance4;
  2609. fglInternalFormat := GL_LUMINANCE4;
  2610. end;
  2611. constructor TfdLuminance8.Create;
  2612. begin
  2613. inherited Create;
  2614. fFormat := tfLuminance8;
  2615. fWithAlpha := tfLuminance8Alpha8;
  2616. fWithoutAlpha := tfLuminance8;
  2617. fglInternalFormat := GL_LUMINANCE8;
  2618. end;
  2619. constructor TfdLuminance12.Create;
  2620. begin
  2621. inherited Create;
  2622. fFormat := tfLuminance12;
  2623. fWithAlpha := tfLuminance12Alpha12;
  2624. fWithoutAlpha := tfLuminance12;
  2625. fglInternalFormat := GL_LUMINANCE12;
  2626. end;
  2627. constructor TfdLuminance16.Create;
  2628. begin
  2629. inherited Create;
  2630. fFormat := tfLuminance16;
  2631. fWithAlpha := tfLuminance16Alpha16;
  2632. fWithoutAlpha := tfLuminance16;
  2633. fglInternalFormat := GL_LUMINANCE16;
  2634. end;
  2635. constructor TfdLuminance4Alpha4.Create;
  2636. begin
  2637. inherited Create;
  2638. fFormat := tfLuminance4Alpha4;
  2639. fWithAlpha := tfLuminance4Alpha4;
  2640. fWithoutAlpha := tfLuminance4;
  2641. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2642. end;
  2643. constructor TfdLuminance6Alpha2.Create;
  2644. begin
  2645. inherited Create;
  2646. fFormat := tfLuminance6Alpha2;
  2647. fWithAlpha := tfLuminance6Alpha2;
  2648. fWithoutAlpha := tfLuminance8;
  2649. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2650. end;
  2651. constructor TfdLuminance8Alpha8.Create;
  2652. begin
  2653. inherited Create;
  2654. fFormat := tfLuminance8Alpha8;
  2655. fWithAlpha := tfLuminance8Alpha8;
  2656. fWithoutAlpha := tfLuminance8;
  2657. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2658. end;
  2659. constructor TfdLuminance12Alpha4.Create;
  2660. begin
  2661. inherited Create;
  2662. fFormat := tfLuminance12Alpha4;
  2663. fWithAlpha := tfLuminance12Alpha4;
  2664. fWithoutAlpha := tfLuminance12;
  2665. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2666. end;
  2667. constructor TfdLuminance12Alpha12.Create;
  2668. begin
  2669. inherited Create;
  2670. fFormat := tfLuminance12Alpha12;
  2671. fWithAlpha := tfLuminance12Alpha12;
  2672. fWithoutAlpha := tfLuminance12;
  2673. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2674. end;
  2675. constructor TfdLuminance16Alpha16.Create;
  2676. begin
  2677. inherited Create;
  2678. fFormat := tfLuminance16Alpha16;
  2679. fWithAlpha := tfLuminance16Alpha16;
  2680. fWithoutAlpha := tfLuminance16;
  2681. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2682. end;
  2683. constructor TfdR3G3B2.Create;
  2684. begin
  2685. inherited Create;
  2686. fFormat := tfR3G3B2;
  2687. fWithAlpha := tfRGBA2;
  2688. fWithoutAlpha := tfR3G3B2;
  2689. fRange.r := $7;
  2690. fRange.g := $7;
  2691. fRange.b := $3;
  2692. fShift.r := 0;
  2693. fShift.g := 3;
  2694. fShift.b := 6;
  2695. fglFormat := GL_RGB;
  2696. fglInternalFormat := GL_R3_G3_B2;
  2697. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2698. end;
  2699. constructor TfdRGB4.Create;
  2700. begin
  2701. inherited Create;
  2702. fFormat := tfRGB4;
  2703. fWithAlpha := tfRGBA4;
  2704. fWithoutAlpha := tfRGB4;
  2705. fRGBInverted := tfBGR4;
  2706. fRange.r := $F;
  2707. fRange.g := $F;
  2708. fRange.b := $F;
  2709. fShift.r := 0;
  2710. fShift.g := 4;
  2711. fShift.b := 8;
  2712. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2713. fglInternalFormat := GL_RGB4;
  2714. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2715. end;
  2716. constructor TfdR5G6B5.Create;
  2717. begin
  2718. inherited Create;
  2719. fFormat := tfR5G6B5;
  2720. fWithAlpha := tfRGBA4;
  2721. fWithoutAlpha := tfR5G6B5;
  2722. fRGBInverted := tfB5G6R5;
  2723. fRange.r := $1F;
  2724. fRange.g := $3F;
  2725. fRange.b := $1F;
  2726. fShift.r := 0;
  2727. fShift.g := 5;
  2728. fShift.b := 11;
  2729. fglFormat := GL_RGB;
  2730. fglInternalFormat := GL_RGB565;
  2731. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2732. end;
  2733. constructor TfdRGB5.Create;
  2734. begin
  2735. inherited Create;
  2736. fFormat := tfRGB5;
  2737. fWithAlpha := tfRGB5A1;
  2738. fWithoutAlpha := tfRGB5;
  2739. fRGBInverted := tfBGR5;
  2740. fRange.r := $1F;
  2741. fRange.g := $1F;
  2742. fRange.b := $1F;
  2743. fShift.r := 0;
  2744. fShift.g := 5;
  2745. fShift.b := 10;
  2746. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2747. fglInternalFormat := GL_RGB5;
  2748. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2749. end;
  2750. constructor TfdRGB8.Create;
  2751. begin
  2752. inherited Create;
  2753. fFormat := tfRGB8;
  2754. fWithAlpha := tfRGBA8;
  2755. fWithoutAlpha := tfRGB8;
  2756. fRGBInverted := tfBGR8;
  2757. fglInternalFormat := GL_RGB8;
  2758. end;
  2759. constructor TfdRGB10.Create;
  2760. begin
  2761. inherited Create;
  2762. fFormat := tfRGB10;
  2763. fWithAlpha := tfRGB10A2;
  2764. fWithoutAlpha := tfRGB10;
  2765. fRGBInverted := tfBGR10;
  2766. fRange.r := $3FF;
  2767. fRange.g := $3FF;
  2768. fRange.b := $3FF;
  2769. fShift.r := 0;
  2770. fShift.g := 10;
  2771. fShift.b := 20;
  2772. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2773. fglInternalFormat := GL_RGB10;
  2774. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2775. end;
  2776. constructor TfdRGB12.Create;
  2777. begin
  2778. inherited Create;
  2779. fFormat := tfRGB12;
  2780. fWithAlpha := tfRGBA12;
  2781. fWithoutAlpha := tfRGB12;
  2782. fRGBInverted := tfBGR12;
  2783. fglInternalFormat := GL_RGB12;
  2784. end;
  2785. constructor TfdRGB16.Create;
  2786. begin
  2787. inherited Create;
  2788. fFormat := tfRGB16;
  2789. fWithAlpha := tfRGBA16;
  2790. fWithoutAlpha := tfRGB16;
  2791. fRGBInverted := tfBGR16;
  2792. fglInternalFormat := GL_RGB16;
  2793. end;
  2794. constructor TfdRGBA2.Create;
  2795. begin
  2796. inherited Create;
  2797. fFormat := tfRGBA2;
  2798. fWithAlpha := tfRGBA2;
  2799. fWithoutAlpha := tfR3G3B2;
  2800. fRGBInverted := tfBGRA2;
  2801. fglInternalFormat := GL_RGBA2;
  2802. end;
  2803. constructor TfdRGBA4.Create;
  2804. begin
  2805. inherited Create;
  2806. fFormat := tfRGBA4;
  2807. fWithAlpha := tfRGBA4;
  2808. fWithoutAlpha := tfRGB4;
  2809. fRGBInverted := tfBGRA4;
  2810. fRange.r := $F;
  2811. fRange.g := $F;
  2812. fRange.b := $F;
  2813. fRange.a := $F;
  2814. fShift.r := 0;
  2815. fShift.g := 4;
  2816. fShift.b := 8;
  2817. fShift.a := 12;
  2818. fglFormat := GL_RGBA;
  2819. fglInternalFormat := GL_RGBA4;
  2820. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2821. end;
  2822. constructor TfdRGB5A1.Create;
  2823. begin
  2824. inherited Create;
  2825. fFormat := tfRGB5A1;
  2826. fWithAlpha := tfRGB5A1;
  2827. fWithoutAlpha := tfRGB5;
  2828. fRGBInverted := tfBGR5A1;
  2829. fRange.r := $1F;
  2830. fRange.g := $1F;
  2831. fRange.b := $1F;
  2832. fRange.a := $01;
  2833. fShift.r := 0;
  2834. fShift.g := 5;
  2835. fShift.b := 10;
  2836. fShift.a := 15;
  2837. fglFormat := GL_RGBA;
  2838. fglInternalFormat := GL_RGB5_A1;
  2839. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2840. end;
  2841. constructor TfdRGBA8.Create;
  2842. begin
  2843. inherited Create;
  2844. fFormat := tfRGBA8;
  2845. fWithAlpha := tfRGBA8;
  2846. fWithoutAlpha := tfRGB8;
  2847. fRGBInverted := tfBGRA8;
  2848. fglInternalFormat := GL_RGBA8;
  2849. end;
  2850. constructor TfdRGB10A2.Create;
  2851. begin
  2852. inherited Create;
  2853. fFormat := tfRGB10A2;
  2854. fWithAlpha := tfRGB10A2;
  2855. fWithoutAlpha := tfRGB10;
  2856. fRGBInverted := tfBGR10A2;
  2857. fRange.r := $3FF;
  2858. fRange.g := $3FF;
  2859. fRange.b := $3FF;
  2860. fRange.a := $003;
  2861. fShift.r := 0;
  2862. fShift.g := 10;
  2863. fShift.b := 20;
  2864. fShift.a := 30;
  2865. fglFormat := GL_RGBA;
  2866. fglInternalFormat := GL_RGB10_A2;
  2867. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2868. end;
  2869. constructor TfdRGBA12.Create;
  2870. begin
  2871. inherited Create;
  2872. fFormat := tfRGBA12;
  2873. fWithAlpha := tfRGBA12;
  2874. fWithoutAlpha := tfRGB12;
  2875. fRGBInverted := tfBGRA12;
  2876. fglInternalFormat := GL_RGBA12;
  2877. end;
  2878. constructor TfdRGBA16.Create;
  2879. begin
  2880. inherited Create;
  2881. fFormat := tfRGBA16;
  2882. fWithAlpha := tfRGBA16;
  2883. fWithoutAlpha := tfRGB16;
  2884. fRGBInverted := tfBGRA16;
  2885. fglInternalFormat := GL_RGBA16;
  2886. end;
  2887. constructor TfdBGR4.Create;
  2888. begin
  2889. inherited Create;
  2890. fPixelSize := 2.0;
  2891. fFormat := tfBGR4;
  2892. fWithAlpha := tfBGRA4;
  2893. fWithoutAlpha := tfBGR4;
  2894. fRGBInverted := tfRGB4;
  2895. fRange.r := $F;
  2896. fRange.g := $F;
  2897. fRange.b := $F;
  2898. fRange.a := $0;
  2899. fShift.r := 8;
  2900. fShift.g := 4;
  2901. fShift.b := 0;
  2902. fShift.a := 0;
  2903. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2904. fglInternalFormat := GL_RGB4;
  2905. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2906. end;
  2907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2908. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2909. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2910. constructor TfdB5G6R5.Create;
  2911. begin
  2912. inherited Create;
  2913. fFormat := tfB5G6R5;
  2914. fWithAlpha := tfBGRA4;
  2915. fWithoutAlpha := tfB5G6R5;
  2916. fRGBInverted := tfR5G6B5;
  2917. fRange.r := $1F;
  2918. fRange.g := $3F;
  2919. fRange.b := $1F;
  2920. fShift.r := 11;
  2921. fShift.g := 5;
  2922. fShift.b := 0;
  2923. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2924. fglInternalFormat := GL_RGB8;
  2925. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2926. end;
  2927. constructor TfdBGR5.Create;
  2928. begin
  2929. inherited Create;
  2930. fPixelSize := 2.0;
  2931. fFormat := tfBGR5;
  2932. fWithAlpha := tfBGR5A1;
  2933. fWithoutAlpha := tfBGR5;
  2934. fRGBInverted := tfRGB5;
  2935. fRange.r := $1F;
  2936. fRange.g := $1F;
  2937. fRange.b := $1F;
  2938. fRange.a := $00;
  2939. fShift.r := 10;
  2940. fShift.g := 5;
  2941. fShift.b := 0;
  2942. fShift.a := 0;
  2943. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2944. fglInternalFormat := GL_RGB5;
  2945. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2946. end;
  2947. constructor TfdBGR8.Create;
  2948. begin
  2949. inherited Create;
  2950. fFormat := tfBGR8;
  2951. fWithAlpha := tfBGRA8;
  2952. fWithoutAlpha := tfBGR8;
  2953. fRGBInverted := tfRGB8;
  2954. fglInternalFormat := GL_RGB8;
  2955. end;
  2956. constructor TfdBGR10.Create;
  2957. begin
  2958. inherited Create;
  2959. fFormat := tfBGR10;
  2960. fWithAlpha := tfBGR10A2;
  2961. fWithoutAlpha := tfBGR10;
  2962. fRGBInverted := tfRGB10;
  2963. fRange.r := $3FF;
  2964. fRange.g := $3FF;
  2965. fRange.b := $3FF;
  2966. fRange.a := $000;
  2967. fShift.r := 20;
  2968. fShift.g := 10;
  2969. fShift.b := 0;
  2970. fShift.a := 0;
  2971. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2972. fglInternalFormat := GL_RGB10;
  2973. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2974. end;
  2975. constructor TfdBGR12.Create;
  2976. begin
  2977. inherited Create;
  2978. fFormat := tfBGR12;
  2979. fWithAlpha := tfBGRA12;
  2980. fWithoutAlpha := tfBGR12;
  2981. fRGBInverted := tfRGB12;
  2982. fglInternalFormat := GL_RGB12;
  2983. end;
  2984. constructor TfdBGR16.Create;
  2985. begin
  2986. inherited Create;
  2987. fFormat := tfBGR16;
  2988. fWithAlpha := tfBGRA16;
  2989. fWithoutAlpha := tfBGR16;
  2990. fRGBInverted := tfRGB16;
  2991. fglInternalFormat := GL_RGB16;
  2992. end;
  2993. constructor TfdBGRA2.Create;
  2994. begin
  2995. inherited Create;
  2996. fFormat := tfBGRA2;
  2997. fWithAlpha := tfBGRA4;
  2998. fWithoutAlpha := tfBGR4;
  2999. fRGBInverted := tfRGBA2;
  3000. fglInternalFormat := GL_RGBA2;
  3001. end;
  3002. constructor TfdBGRA4.Create;
  3003. begin
  3004. inherited Create;
  3005. fFormat := tfBGRA4;
  3006. fWithAlpha := tfBGRA4;
  3007. fWithoutAlpha := tfBGR4;
  3008. fRGBInverted := tfRGBA4;
  3009. fRange.r := $F;
  3010. fRange.g := $F;
  3011. fRange.b := $F;
  3012. fRange.a := $F;
  3013. fShift.r := 8;
  3014. fShift.g := 4;
  3015. fShift.b := 0;
  3016. fShift.a := 12;
  3017. fglFormat := GL_BGRA;
  3018. fglInternalFormat := GL_RGBA4;
  3019. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3020. end;
  3021. constructor TfdBGR5A1.Create;
  3022. begin
  3023. inherited Create;
  3024. fFormat := tfBGR5A1;
  3025. fWithAlpha := tfBGR5A1;
  3026. fWithoutAlpha := tfBGR5;
  3027. fRGBInverted := tfRGB5A1;
  3028. fRange.r := $1F;
  3029. fRange.g := $1F;
  3030. fRange.b := $1F;
  3031. fRange.a := $01;
  3032. fShift.r := 10;
  3033. fShift.g := 5;
  3034. fShift.b := 0;
  3035. fShift.a := 15;
  3036. fglFormat := GL_BGRA;
  3037. fglInternalFormat := GL_RGB5_A1;
  3038. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3039. end;
  3040. constructor TfdBGRA8.Create;
  3041. begin
  3042. inherited Create;
  3043. fFormat := tfBGRA8;
  3044. fWithAlpha := tfBGRA8;
  3045. fWithoutAlpha := tfBGR8;
  3046. fRGBInverted := tfRGBA8;
  3047. fglInternalFormat := GL_RGBA8;
  3048. end;
  3049. constructor TfdBGR10A2.Create;
  3050. begin
  3051. inherited Create;
  3052. fFormat := tfBGR10A2;
  3053. fWithAlpha := tfBGR10A2;
  3054. fWithoutAlpha := tfBGR10;
  3055. fRGBInverted := tfRGB10A2;
  3056. fRange.r := $3FF;
  3057. fRange.g := $3FF;
  3058. fRange.b := $3FF;
  3059. fRange.a := $003;
  3060. fShift.r := 20;
  3061. fShift.g := 10;
  3062. fShift.b := 0;
  3063. fShift.a := 30;
  3064. fglFormat := GL_BGRA;
  3065. fglInternalFormat := GL_RGB10_A2;
  3066. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3067. end;
  3068. constructor TfdBGRA12.Create;
  3069. begin
  3070. inherited Create;
  3071. fFormat := tfBGRA12;
  3072. fWithAlpha := tfBGRA12;
  3073. fWithoutAlpha := tfBGR12;
  3074. fRGBInverted := tfRGBA12;
  3075. fglInternalFormat := GL_RGBA12;
  3076. end;
  3077. constructor TfdBGRA16.Create;
  3078. begin
  3079. inherited Create;
  3080. fFormat := tfBGRA16;
  3081. fWithAlpha := tfBGRA16;
  3082. fWithoutAlpha := tfBGR16;
  3083. fRGBInverted := tfRGBA16;
  3084. fglInternalFormat := GL_RGBA16;
  3085. end;
  3086. constructor TfdDepth16.Create;
  3087. begin
  3088. inherited Create;
  3089. fFormat := tfDepth16;
  3090. fWithAlpha := tfEmpty;
  3091. fWithoutAlpha := tfDepth16;
  3092. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3093. end;
  3094. constructor TfdDepth24.Create;
  3095. begin
  3096. inherited Create;
  3097. fFormat := tfDepth24;
  3098. fWithAlpha := tfEmpty;
  3099. fWithoutAlpha := tfDepth24;
  3100. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3101. end;
  3102. constructor TfdDepth32.Create;
  3103. begin
  3104. inherited Create;
  3105. fFormat := tfDepth32;
  3106. fWithAlpha := tfEmpty;
  3107. fWithoutAlpha := tfDepth32;
  3108. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3109. end;
  3110. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3111. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3112. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3113. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3114. begin
  3115. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3116. end;
  3117. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3118. begin
  3119. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3120. end;
  3121. constructor TfdS3tcDtx1RGBA.Create;
  3122. begin
  3123. inherited Create;
  3124. fFormat := tfS3tcDtx1RGBA;
  3125. fWithAlpha := tfS3tcDtx1RGBA;
  3126. fUncompressed := tfRGB5A1;
  3127. fPixelSize := 0.5;
  3128. fIsCompressed := true;
  3129. fglFormat := GL_COMPRESSED_RGBA;
  3130. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3131. fglDataFormat := GL_UNSIGNED_BYTE;
  3132. end;
  3133. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3134. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3136. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3137. begin
  3138. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3139. end;
  3140. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3141. begin
  3142. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3143. end;
  3144. constructor TfdS3tcDtx3RGBA.Create;
  3145. begin
  3146. inherited Create;
  3147. fFormat := tfS3tcDtx3RGBA;
  3148. fWithAlpha := tfS3tcDtx3RGBA;
  3149. fUncompressed := tfRGBA8;
  3150. fPixelSize := 1.0;
  3151. fIsCompressed := true;
  3152. fglFormat := GL_COMPRESSED_RGBA;
  3153. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3154. fglDataFormat := GL_UNSIGNED_BYTE;
  3155. end;
  3156. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3157. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3158. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3159. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3160. begin
  3161. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3162. end;
  3163. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3164. begin
  3165. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3166. end;
  3167. constructor TfdS3tcDtx5RGBA.Create;
  3168. begin
  3169. inherited Create;
  3170. fFormat := tfS3tcDtx3RGBA;
  3171. fWithAlpha := tfS3tcDtx3RGBA;
  3172. fUncompressed := tfRGBA8;
  3173. fPixelSize := 1.0;
  3174. fIsCompressed := true;
  3175. fglFormat := GL_COMPRESSED_RGBA;
  3176. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3177. fglDataFormat := GL_UNSIGNED_BYTE;
  3178. end;
  3179. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3180. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3181. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3182. class procedure TFormatDescriptor.Init;
  3183. begin
  3184. if not Assigned(FormatDescriptorCS) then
  3185. FormatDescriptorCS := TCriticalSection.Create;
  3186. end;
  3187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3188. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3189. begin
  3190. FormatDescriptorCS.Enter;
  3191. try
  3192. result := FormatDescriptors[aFormat];
  3193. if not Assigned(result) then begin
  3194. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3195. FormatDescriptors[aFormat] := result;
  3196. end;
  3197. finally
  3198. FormatDescriptorCS.Leave;
  3199. end;
  3200. end;
  3201. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3202. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3203. begin
  3204. result := Get(Get(aFormat).WithAlpha);
  3205. end;
  3206. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3207. class procedure TFormatDescriptor.Clear;
  3208. var
  3209. f: TglBitmapFormat;
  3210. begin
  3211. FormatDescriptorCS.Enter;
  3212. try
  3213. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3214. FreeAndNil(FormatDescriptors[f]);
  3215. finally
  3216. FormatDescriptorCS.Leave;
  3217. end;
  3218. end;
  3219. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3220. class procedure TFormatDescriptor.Finalize;
  3221. begin
  3222. Clear;
  3223. FreeAndNil(FormatDescriptorCS);
  3224. end;
  3225. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3226. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3227. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3228. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3229. begin
  3230. Update(aValue, fRange.r, fShift.r);
  3231. end;
  3232. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3233. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3234. begin
  3235. Update(aValue, fRange.g, fShift.g);
  3236. end;
  3237. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3238. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3239. begin
  3240. Update(aValue, fRange.b, fShift.b);
  3241. end;
  3242. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3243. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3244. begin
  3245. Update(aValue, fRange.a, fShift.a);
  3246. end;
  3247. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3248. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3249. aShift: Byte);
  3250. begin
  3251. aShift := 0;
  3252. aRange := 0;
  3253. if (aMask = 0) then
  3254. exit;
  3255. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3256. inc(aShift);
  3257. aMask := aMask shr 1;
  3258. end;
  3259. aRange := 1;
  3260. while (aMask > 0) do begin
  3261. aRange := aRange shl 1;
  3262. aMask := aMask shr 1;
  3263. end;
  3264. dec(aRange);
  3265. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3266. end;
  3267. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3268. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3269. var
  3270. data: QWord;
  3271. s: Integer;
  3272. begin
  3273. data :=
  3274. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3275. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3276. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3277. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3278. s := Round(fPixelSize);
  3279. case s of
  3280. 1: aData^ := data;
  3281. 2: PWord(aData)^ := data;
  3282. 4: PCardinal(aData)^ := data;
  3283. 8: PQWord(aData)^ := data;
  3284. else
  3285. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3286. end;
  3287. inc(aData, s);
  3288. end;
  3289. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3290. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3291. var
  3292. data: QWord;
  3293. s, i: Integer;
  3294. begin
  3295. s := Round(fPixelSize);
  3296. case s of
  3297. 1: data := aData^;
  3298. 2: data := PWord(aData)^;
  3299. 4: data := PCardinal(aData)^;
  3300. 8: data := PQWord(aData)^;
  3301. else
  3302. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3303. end;
  3304. for i := 0 to 3 do
  3305. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3306. inc(aData, s);
  3307. end;
  3308. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3309. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3310. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3311. procedure TbmpColorTableFormat.CreateColorTable;
  3312. var
  3313. i: Integer;
  3314. begin
  3315. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3316. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3317. if (Format = tfLuminance4) then
  3318. SetLength(fColorTable, 16)
  3319. else
  3320. SetLength(fColorTable, 256);
  3321. case Format of
  3322. tfLuminance4: begin
  3323. for i := 0 to High(fColorTable) do begin
  3324. fColorTable[i].r := 16 * i;
  3325. fColorTable[i].g := 16 * i;
  3326. fColorTable[i].b := 16 * i;
  3327. fColorTable[i].a := 0;
  3328. end;
  3329. end;
  3330. tfLuminance8: begin
  3331. for i := 0 to High(fColorTable) do begin
  3332. fColorTable[i].r := i;
  3333. fColorTable[i].g := i;
  3334. fColorTable[i].b := i;
  3335. fColorTable[i].a := 0;
  3336. end;
  3337. end;
  3338. tfR3G3B2: begin
  3339. for i := 0 to High(fColorTable) do begin
  3340. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3341. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3342. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3343. fColorTable[i].a := 0;
  3344. end;
  3345. end;
  3346. end;
  3347. end;
  3348. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3349. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3350. var
  3351. d: Byte;
  3352. begin
  3353. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3354. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3355. case Format of
  3356. tfLuminance4: begin
  3357. if (aMapData = nil) then
  3358. aData^ := 0;
  3359. d := LuminanceWeight(aPixel) and Range.r;
  3360. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3361. inc(PByte(aMapData), 4);
  3362. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3363. inc(aData);
  3364. aMapData := nil;
  3365. end;
  3366. end;
  3367. tfLuminance8: begin
  3368. aData^ := LuminanceWeight(aPixel) and Range.r;
  3369. inc(aData);
  3370. end;
  3371. tfR3G3B2: begin
  3372. aData^ := Round(
  3373. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3374. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3375. ((aPixel.Data.b and Range.b) shl Shift.b));
  3376. inc(aData);
  3377. end;
  3378. end;
  3379. end;
  3380. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3381. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3382. var
  3383. idx: QWord;
  3384. s: Integer;
  3385. bits: Byte;
  3386. f: Single;
  3387. begin
  3388. s := Trunc(fPixelSize);
  3389. f := fPixelSize - s;
  3390. bits := Round(8 * f);
  3391. case s of
  3392. 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
  3393. 1: idx := aData^;
  3394. 2: idx := PWord(aData)^;
  3395. 4: idx := PCardinal(aData)^;
  3396. 8: idx := PQWord(aData)^;
  3397. else
  3398. raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3399. end;
  3400. if (idx >= Length(fColorTable)) then
  3401. raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
  3402. with fColorTable[idx] do begin
  3403. aPixel.Data.r := r;
  3404. aPixel.Data.g := g;
  3405. aPixel.Data.b := b;
  3406. aPixel.Data.a := a;
  3407. end;
  3408. inc(PByte(aMapData), bits);
  3409. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3410. inc(aData, 1);
  3411. dec(PByte(aMapData), 8);
  3412. end;
  3413. inc(aData, s);
  3414. end;
  3415. destructor TbmpColorTableFormat.Destroy;
  3416. begin
  3417. SetLength(fColorTable, 0);
  3418. inherited Destroy;
  3419. end;
  3420. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3421. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3422. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3423. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3424. var
  3425. i: Integer;
  3426. begin
  3427. for i := 0 to 3 do begin
  3428. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3429. if (aSourceFD.Range.arr[i] > 0) then
  3430. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3431. else
  3432. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3433. end;
  3434. end;
  3435. end;
  3436. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3437. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3438. begin
  3439. with aFuncRec do begin
  3440. if (Source.Range.r > 0) then
  3441. Dest.Data.r := Source.Data.r;
  3442. if (Source.Range.g > 0) then
  3443. Dest.Data.g := Source.Data.g;
  3444. if (Source.Range.b > 0) then
  3445. Dest.Data.b := Source.Data.b;
  3446. if (Source.Range.a > 0) then
  3447. Dest.Data.a := Source.Data.a;
  3448. end;
  3449. end;
  3450. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3451. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3452. var
  3453. i: Integer;
  3454. begin
  3455. with aFuncRec do begin
  3456. for i := 0 to 3 do
  3457. if (Source.Range.arr[i] > 0) then
  3458. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3459. end;
  3460. end;
  3461. type
  3462. TShiftData = packed record
  3463. case Integer of
  3464. 0: (r, g, b, a: SmallInt);
  3465. 1: (arr: array[0..3] of SmallInt);
  3466. end;
  3467. PShiftData = ^TShiftData;
  3468. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3469. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3470. var
  3471. i: Integer;
  3472. begin
  3473. with aFuncRec do
  3474. for i := 0 to 3 do
  3475. if (Source.Range.arr[i] > 0) then
  3476. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3477. end;
  3478. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3479. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3480. begin
  3481. with aFuncRec do begin
  3482. Dest.Data := Source.Data;
  3483. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3484. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3485. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3486. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3487. end;
  3488. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3489. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3490. end;
  3491. end;
  3492. end;
  3493. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3494. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3495. var
  3496. i: Integer;
  3497. begin
  3498. with aFuncRec do begin
  3499. for i := 0 to 3 do
  3500. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3501. end;
  3502. end;
  3503. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3504. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3505. var
  3506. Temp: Single;
  3507. begin
  3508. with FuncRec do begin
  3509. if (FuncRec.Args = nil) then begin //source has no alpha
  3510. Temp :=
  3511. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3512. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3513. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3514. Dest.Data.a := Round(Dest.Range.a * Temp);
  3515. end else
  3516. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3517. end;
  3518. end;
  3519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3520. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3521. type
  3522. PglBitmapPixelData = ^TglBitmapPixelData;
  3523. begin
  3524. with FuncRec do begin
  3525. Dest.Data.r := Source.Data.r;
  3526. Dest.Data.g := Source.Data.g;
  3527. Dest.Data.b := Source.Data.b;
  3528. with PglBitmapPixelData(Args)^ do
  3529. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3530. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3531. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3532. Dest.Data.a := 0
  3533. else
  3534. Dest.Data.a := Dest.Range.a;
  3535. end;
  3536. end;
  3537. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3538. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3539. begin
  3540. with FuncRec do begin
  3541. Dest.Data.r := Source.Data.r;
  3542. Dest.Data.g := Source.Data.g;
  3543. Dest.Data.b := Source.Data.b;
  3544. Dest.Data.a := PCardinal(Args)^;
  3545. end;
  3546. end;
  3547. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3548. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3549. type
  3550. PRGBPix = ^TRGBPix;
  3551. TRGBPix = array [0..2] of byte;
  3552. var
  3553. Temp: Byte;
  3554. begin
  3555. while aWidth > 0 do begin
  3556. Temp := PRGBPix(aData)^[0];
  3557. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3558. PRGBPix(aData)^[2] := Temp;
  3559. if aHasAlpha then
  3560. Inc(aData, 4)
  3561. else
  3562. Inc(aData, 3);
  3563. dec(aWidth);
  3564. end;
  3565. end;
  3566. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3567. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3568. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3569. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  3570. begin
  3571. result := TFormatDescriptor.Get(Format);
  3572. end;
  3573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3574. function TglBitmap.GetWidth: Integer;
  3575. begin
  3576. if (ffX in fDimension.Fields) then
  3577. result := fDimension.X
  3578. else
  3579. result := -1;
  3580. end;
  3581. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3582. function TglBitmap.GetHeight: Integer;
  3583. begin
  3584. if (ffY in fDimension.Fields) then
  3585. result := fDimension.Y
  3586. else
  3587. result := -1;
  3588. end;
  3589. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3590. function TglBitmap.GetFileWidth: Integer;
  3591. begin
  3592. result := Max(1, Width);
  3593. end;
  3594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3595. function TglBitmap.GetFileHeight: Integer;
  3596. begin
  3597. result := Max(1, Height);
  3598. end;
  3599. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3600. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3601. begin
  3602. if fCustomData = aValue then
  3603. exit;
  3604. fCustomData := aValue;
  3605. end;
  3606. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3607. procedure TglBitmap.SetCustomName(const aValue: String);
  3608. begin
  3609. if fCustomName = aValue then
  3610. exit;
  3611. fCustomName := aValue;
  3612. end;
  3613. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3614. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3615. begin
  3616. if fCustomNameW = aValue then
  3617. exit;
  3618. fCustomNameW := aValue;
  3619. end;
  3620. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3621. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3622. begin
  3623. if fDeleteTextureOnFree = aValue then
  3624. exit;
  3625. fDeleteTextureOnFree := aValue;
  3626. end;
  3627. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3628. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3629. begin
  3630. if fFormat = aValue then
  3631. exit;
  3632. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3633. raise EglBitmapUnsupportedFormat.Create(Format);
  3634. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  3635. end;
  3636. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3637. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3638. begin
  3639. if fFreeDataAfterGenTexture = aValue then
  3640. exit;
  3641. fFreeDataAfterGenTexture := aValue;
  3642. end;
  3643. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3644. procedure TglBitmap.SetID(const aValue: Cardinal);
  3645. begin
  3646. if fID = aValue then
  3647. exit;
  3648. fID := aValue;
  3649. end;
  3650. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3651. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3652. begin
  3653. if fMipMap = aValue then
  3654. exit;
  3655. fMipMap := aValue;
  3656. end;
  3657. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3658. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3659. begin
  3660. if fTarget = aValue then
  3661. exit;
  3662. fTarget := aValue;
  3663. end;
  3664. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3665. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3666. var
  3667. MaxAnisotropic: Integer;
  3668. begin
  3669. fAnisotropic := aValue;
  3670. if (ID > 0) then begin
  3671. if GL_EXT_texture_filter_anisotropic then begin
  3672. if fAnisotropic > 0 then begin
  3673. Bind(false);
  3674. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3675. if aValue > MaxAnisotropic then
  3676. fAnisotropic := MaxAnisotropic;
  3677. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3678. end;
  3679. end else begin
  3680. fAnisotropic := 0;
  3681. end;
  3682. end;
  3683. end;
  3684. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3685. procedure TglBitmap.CreateID;
  3686. begin
  3687. if (ID <> 0) then
  3688. glDeleteTextures(1, @fID);
  3689. glGenTextures(1, @fID);
  3690. Bind(false);
  3691. end;
  3692. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3693. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3694. begin
  3695. // Set Up Parameters
  3696. SetWrap(fWrapS, fWrapT, fWrapR);
  3697. SetFilter(fFilterMin, fFilterMag);
  3698. SetAnisotropic(fAnisotropic);
  3699. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3700. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  3701. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3702. // Mip Maps Generation Mode
  3703. aBuildWithGlu := false;
  3704. if (MipMap = mmMipmap) then begin
  3705. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3706. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3707. else
  3708. aBuildWithGlu := true;
  3709. end else if (MipMap = mmMipmapGlu) then
  3710. aBuildWithGlu := true;
  3711. end;
  3712. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3713. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  3714. const aWidth: Integer; const aHeight: Integer);
  3715. var
  3716. s: Single;
  3717. begin
  3718. if (Data <> aData) then begin
  3719. if (Assigned(Data)) then
  3720. FreeMem(Data);
  3721. fData := aData;
  3722. end;
  3723. FillChar(fDimension, SizeOf(fDimension), 0);
  3724. if not Assigned(fData) then begin
  3725. fFormat := tfEmpty;
  3726. fPixelSize := 0;
  3727. fRowSize := 0;
  3728. end else begin
  3729. if aWidth <> -1 then begin
  3730. fDimension.Fields := fDimension.Fields + [ffX];
  3731. fDimension.X := aWidth;
  3732. end;
  3733. if aHeight <> -1 then begin
  3734. fDimension.Fields := fDimension.Fields + [ffY];
  3735. fDimension.Y := aHeight;
  3736. end;
  3737. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3738. fFormat := aFormat;
  3739. fPixelSize := Ceil(s);
  3740. fRowSize := Ceil(s * aWidth);
  3741. end;
  3742. end;
  3743. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3744. function TglBitmap.FlipHorz: Boolean;
  3745. begin
  3746. result := false;
  3747. end;
  3748. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3749. function TglBitmap.FlipVert: Boolean;
  3750. begin
  3751. result := false;
  3752. end;
  3753. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3754. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3755. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3756. procedure TglBitmap.AfterConstruction;
  3757. begin
  3758. inherited AfterConstruction;
  3759. fID := 0;
  3760. fTarget := 0;
  3761. fIsResident := false;
  3762. fFormat := glBitmapGetDefaultFormat;
  3763. fMipMap := glBitmapDefaultMipmap;
  3764. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3765. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3766. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3767. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3768. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3769. end;
  3770. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3771. procedure TglBitmap.BeforeDestruction;
  3772. var
  3773. NewData: PByte;
  3774. begin
  3775. NewData := nil;
  3776. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  3777. if (fID > 0) and fDeleteTextureOnFree then
  3778. glDeleteTextures(1, @fID);
  3779. inherited BeforeDestruction;
  3780. end;
  3781. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3782. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  3783. var
  3784. TempPos: Integer;
  3785. begin
  3786. if not Assigned(aResType) then begin
  3787. TempPos := Pos('.', aResource);
  3788. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3789. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3790. end;
  3791. end;
  3792. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3793. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3794. var
  3795. fs: TFileStream;
  3796. begin
  3797. if not FileExists(aFilename) then
  3798. raise EglBitmap.Create('file does not exist: ' + aFilename);
  3799. fFilename := aFilename;
  3800. fs := TFileStream.Create(fFilename, fmOpenRead);
  3801. try
  3802. fs.Position := 0;
  3803. LoadFromStream(fs);
  3804. finally
  3805. fs.Free;
  3806. end;
  3807. end;
  3808. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3809. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3810. begin
  3811. {$IFDEF GLB_SUPPORT_PNG_READ}
  3812. if not LoadPNG(aStream) then
  3813. {$ENDIF}
  3814. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3815. if not LoadJPEG(aStream) then
  3816. {$ENDIF}
  3817. if not LoadDDS(aStream) then
  3818. if not LoadTGA(aStream) then
  3819. if not LoadBMP(aStream) then
  3820. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3821. end;
  3822. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3823. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3824. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3825. var
  3826. tmpData: PByte;
  3827. size: Integer;
  3828. begin
  3829. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3830. GetMem(tmpData, size);
  3831. try
  3832. FillChar(tmpData^, size, #$FF);
  3833. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  3834. except
  3835. if Assigned(tmpData) then
  3836. FreeMem(tmpData);
  3837. raise;
  3838. end;
  3839. AddFunc(Self, aFunc, false, Format, aArgs);
  3840. end;
  3841. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3842. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  3843. var
  3844. rs: TResourceStream;
  3845. begin
  3846. PrepareResType(aResource, aResType);
  3847. rs := TResourceStream.Create(aInstance, aResource, aResType);
  3848. try
  3849. LoadFromStream(rs);
  3850. finally
  3851. rs.Free;
  3852. end;
  3853. end;
  3854. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3855. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3856. var
  3857. rs: TResourceStream;
  3858. begin
  3859. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  3860. try
  3861. LoadFromStream(rs);
  3862. finally
  3863. rs.Free;
  3864. end;
  3865. end;
  3866. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3867. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3868. var
  3869. fs: TFileStream;
  3870. begin
  3871. fs := TFileStream.Create(aFileName, fmCreate);
  3872. try
  3873. fs.Position := 0;
  3874. SaveToStream(fs, aFileType);
  3875. finally
  3876. fs.Free;
  3877. end;
  3878. end;
  3879. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3880. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3881. begin
  3882. case aFileType of
  3883. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3884. ftPNG: SavePNG(aStream);
  3885. {$ENDIF}
  3886. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3887. ftJPEG: SaveJPEG(aStream);
  3888. {$ENDIF}
  3889. ftDDS: SaveDDS(aStream);
  3890. ftTGA: SaveTGA(aStream);
  3891. ftBMP: SaveBMP(aStream);
  3892. end;
  3893. end;
  3894. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3895. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3896. begin
  3897. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3898. end;
  3899. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3900. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3901. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3902. var
  3903. DestData, TmpData, SourceData: pByte;
  3904. TempHeight, TempWidth: Integer;
  3905. SourceFD, DestFD: TFormatDescriptor;
  3906. SourceMD, DestMD: Pointer;
  3907. FuncRec: TglBitmapFunctionRec;
  3908. begin
  3909. Assert(Assigned(Data));
  3910. Assert(Assigned(aSource));
  3911. Assert(Assigned(aSource.Data));
  3912. result := false;
  3913. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3914. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3915. DestFD := TFormatDescriptor.Get(aFormat);
  3916. if (SourceFD.IsCompressed) then
  3917. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  3918. if (DestFD.IsCompressed) then
  3919. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  3920. // inkompatible Formats so CreateTemp
  3921. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3922. aCreateTemp := true;
  3923. // Values
  3924. TempHeight := Max(1, aSource.Height);
  3925. TempWidth := Max(1, aSource.Width);
  3926. FuncRec.Sender := Self;
  3927. FuncRec.Args := aArgs;
  3928. TmpData := nil;
  3929. if aCreateTemp then begin
  3930. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  3931. DestData := TmpData;
  3932. end else
  3933. DestData := Data;
  3934. try
  3935. SourceFD.PreparePixel(FuncRec.Source);
  3936. DestFD.PreparePixel (FuncRec.Dest);
  3937. SourceMD := SourceFD.CreateMappingData;
  3938. DestMD := DestFD.CreateMappingData;
  3939. FuncRec.Size := aSource.Dimension;
  3940. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3941. try
  3942. SourceData := aSource.Data;
  3943. FuncRec.Position.Y := 0;
  3944. while FuncRec.Position.Y < TempHeight do begin
  3945. FuncRec.Position.X := 0;
  3946. while FuncRec.Position.X < TempWidth do begin
  3947. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3948. aFunc(FuncRec);
  3949. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3950. inc(FuncRec.Position.X);
  3951. end;
  3952. inc(FuncRec.Position.Y);
  3953. end;
  3954. // Updating Image or InternalFormat
  3955. if aCreateTemp then
  3956. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  3957. else if (aFormat <> fFormat) then
  3958. Format := aFormat;
  3959. result := true;
  3960. finally
  3961. SourceFD.FreeMappingData(SourceMD);
  3962. DestFD.FreeMappingData(DestMD);
  3963. end;
  3964. except
  3965. if aCreateTemp and Assigned(TmpData) then
  3966. FreeMem(TmpData);
  3967. raise;
  3968. end;
  3969. end;
  3970. end;
  3971. {$IFDEF GLB_SDL}
  3972. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3973. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  3974. var
  3975. Row, RowSize: Integer;
  3976. SourceData, TmpData: PByte;
  3977. TempDepth: Integer;
  3978. FormatDesc: TFormatDescriptor;
  3979. function GetRowPointer(Row: Integer): pByte;
  3980. begin
  3981. result := aSurface.pixels;
  3982. Inc(result, Row * RowSize);
  3983. end;
  3984. begin
  3985. result := false;
  3986. FormatDesc := TFormatDescriptor.Get(Format);
  3987. if FormatDesc.IsCompressed then
  3988. raise EglBitmapUnsupportedFormat.Create(Format);
  3989. if Assigned(Data) then begin
  3990. case Trunc(FormatDesc.PixelSize) of
  3991. 1: TempDepth := 8;
  3992. 2: TempDepth := 16;
  3993. 3: TempDepth := 24;
  3994. 4: TempDepth := 32;
  3995. else
  3996. raise EglBitmapUnsupportedFormat.Create(Format);
  3997. end;
  3998. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  3999. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4000. SourceData := Data;
  4001. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4002. for Row := 0 to FileHeight-1 do begin
  4003. TmpData := GetRowPointer(Row);
  4004. if Assigned(TmpData) then begin
  4005. Move(SourceData^, TmpData^, RowSize);
  4006. inc(SourceData, RowSize);
  4007. end;
  4008. end;
  4009. result := true;
  4010. end;
  4011. end;
  4012. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4013. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4014. var
  4015. pSource, pData, pTempData: PByte;
  4016. Row, RowSize, TempWidth, TempHeight: Integer;
  4017. IntFormat: TglBitmapFormat;
  4018. FormatDesc: TFormatDescriptor;
  4019. function GetRowPointer(Row: Integer): pByte;
  4020. begin
  4021. result := aSurface^.pixels;
  4022. Inc(result, Row * RowSize);
  4023. end;
  4024. begin
  4025. result := false;
  4026. if (Assigned(aSurface)) then begin
  4027. with aSurface^.format^ do begin
  4028. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  4029. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4030. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  4031. break;
  4032. end;
  4033. if (IntFormat = tfEmpty) then
  4034. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  4035. end;
  4036. TempWidth := aSurface^.w;
  4037. TempHeight := aSurface^.h;
  4038. RowSize := FormatDesc.GetSize(TempWidth, 1);
  4039. GetMem(pData, TempHeight * RowSize);
  4040. try
  4041. pTempData := pData;
  4042. for Row := 0 to TempHeight -1 do begin
  4043. pSource := GetRowPointer(Row);
  4044. if (Assigned(pSource)) then begin
  4045. Move(pSource^, pTempData^, RowSize);
  4046. Inc(pTempData, RowSize);
  4047. end;
  4048. end;
  4049. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4050. result := true;
  4051. except
  4052. if Assigned(pData) then
  4053. FreeMem(pData);
  4054. raise;
  4055. end;
  4056. end;
  4057. end;
  4058. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4059. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4060. var
  4061. Row, Col, AlphaInterleave: Integer;
  4062. pSource, pDest: PByte;
  4063. function GetRowPointer(Row: Integer): pByte;
  4064. begin
  4065. result := aSurface.pixels;
  4066. Inc(result, Row * Width);
  4067. end;
  4068. begin
  4069. result := false;
  4070. if Assigned(Data) then begin
  4071. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  4072. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4073. AlphaInterleave := 0;
  4074. case Format of
  4075. tfLuminance8Alpha8:
  4076. AlphaInterleave := 1;
  4077. tfBGRA8, tfRGBA8:
  4078. AlphaInterleave := 3;
  4079. end;
  4080. pSource := Data;
  4081. for Row := 0 to Height -1 do begin
  4082. pDest := GetRowPointer(Row);
  4083. if Assigned(pDest) then begin
  4084. for Col := 0 to Width -1 do begin
  4085. Inc(pSource, AlphaInterleave);
  4086. pDest^ := pSource^;
  4087. Inc(pDest);
  4088. Inc(pSource);
  4089. end;
  4090. end;
  4091. end;
  4092. result := true;
  4093. end;
  4094. end;
  4095. end;
  4096. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4097. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4098. var
  4099. bmp: TglBitmap2D;
  4100. begin
  4101. bmp := TglBitmap2D.Create;
  4102. try
  4103. bmp.AssignFromSurface(aSurface);
  4104. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4105. finally
  4106. bmp.Free;
  4107. end;
  4108. end;
  4109. {$ENDIF}
  4110. {$IFDEF GLB_DELPHI}
  4111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4112. function CreateGrayPalette: HPALETTE;
  4113. var
  4114. Idx: Integer;
  4115. Pal: PLogPalette;
  4116. begin
  4117. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4118. Pal.palVersion := $300;
  4119. Pal.palNumEntries := 256;
  4120. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4121. Pal.palPalEntry[Idx].peRed := Idx;
  4122. Pal.palPalEntry[Idx].peGreen := Idx;
  4123. Pal.palPalEntry[Idx].peBlue := Idx;
  4124. Pal.palPalEntry[Idx].peFlags := 0;
  4125. end;
  4126. Result := CreatePalette(Pal^);
  4127. FreeMem(Pal);
  4128. end;
  4129. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4130. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4131. var
  4132. Row: Integer;
  4133. pSource, pData: PByte;
  4134. begin
  4135. result := false;
  4136. if Assigned(Data) then begin
  4137. if Assigned(aBitmap) then begin
  4138. aBitmap.Width := Width;
  4139. aBitmap.Height := Height;
  4140. case Format of
  4141. tfAlpha8, tfLuminance8: begin
  4142. aBitmap.PixelFormat := pf8bit;
  4143. aBitmap.Palette := CreateGrayPalette;
  4144. end;
  4145. tfRGB5A1:
  4146. aBitmap.PixelFormat := pf15bit;
  4147. tfR5G6B5:
  4148. aBitmap.PixelFormat := pf16bit;
  4149. tfRGB8, tfBGR8:
  4150. aBitmap.PixelFormat := pf24bit;
  4151. tfRGBA8, tfBGRA8:
  4152. aBitmap.PixelFormat := pf32bit;
  4153. else
  4154. raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
  4155. end;
  4156. pSource := Data;
  4157. for Row := 0 to FileHeight -1 do begin
  4158. pData := aBitmap.Scanline[Row];
  4159. Move(pSource^, pData^, fRowSize);
  4160. Inc(pSource, fRowSize);
  4161. if (Format in [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A)
  4162. SwapRGB(pData, FileWidth, Format = tfRGBA8);
  4163. end;
  4164. result := true;
  4165. end;
  4166. end;
  4167. end;
  4168. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4169. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4170. var
  4171. pSource, pData, pTempData: PByte;
  4172. Row, RowSize, TempWidth, TempHeight: Integer;
  4173. IntFormat: TglBitmapFormat;
  4174. begin
  4175. result := false;
  4176. if (Assigned(aBitmap)) then begin
  4177. case aBitmap.PixelFormat of
  4178. pf8bit:
  4179. IntFormat := tfLuminance8;
  4180. pf15bit:
  4181. IntFormat := tfRGB5A1;
  4182. pf16bit:
  4183. IntFormat := tfR5G6B5;
  4184. pf24bit:
  4185. IntFormat := tfBGR8;
  4186. pf32bit:
  4187. IntFormat := tfBGRA8;
  4188. else
  4189. raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
  4190. end;
  4191. TempWidth := aBitmap.Width;
  4192. TempHeight := aBitmap.Height;
  4193. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4194. GetMem(pData, TempHeight * RowSize);
  4195. try
  4196. pTempData := pData;
  4197. for Row := 0 to TempHeight -1 do begin
  4198. pSource := aBitmap.Scanline[Row];
  4199. if (Assigned(pSource)) then begin
  4200. Move(pSource^, pTempData^, RowSize);
  4201. Inc(pTempData, RowSize);
  4202. end;
  4203. end;
  4204. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4205. result := true;
  4206. except
  4207. if Assigned(pData) then
  4208. FreeMem(pData);
  4209. raise;
  4210. end;
  4211. end;
  4212. end;
  4213. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4214. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4215. var
  4216. Row, Col, AlphaInterleave: Integer;
  4217. pSource, pDest: PByte;
  4218. begin
  4219. result := false;
  4220. if Assigned(Data) then begin
  4221. if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
  4222. if Assigned(aBitmap) then begin
  4223. aBitmap.PixelFormat := pf8bit;
  4224. aBitmap.Palette := CreateGrayPalette;
  4225. aBitmap.Width := Width;
  4226. aBitmap.Height := Height;
  4227. case Format of
  4228. tfLuminance8Alpha8:
  4229. AlphaInterleave := 1;
  4230. tfRGBA8, tfBGRA8:
  4231. AlphaInterleave := 3;
  4232. else
  4233. AlphaInterleave := 0;
  4234. end;
  4235. // Copy Data
  4236. pSource := Data;
  4237. for Row := 0 to Height -1 do begin
  4238. pDest := aBitmap.Scanline[Row];
  4239. if Assigned(pDest) then begin
  4240. for Col := 0 to Width -1 do begin
  4241. Inc(pSource, AlphaInterleave);
  4242. pDest^ := pSource^;
  4243. Inc(pDest);
  4244. Inc(pSource);
  4245. end;
  4246. end;
  4247. end;
  4248. result := true;
  4249. end;
  4250. end;
  4251. end;
  4252. end;
  4253. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4254. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4255. var
  4256. tex: TglBitmap2D;
  4257. begin
  4258. tex := TglBitmap2D.Create;
  4259. try
  4260. tex.AssignFromBitmap(ABitmap);
  4261. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4262. finally
  4263. tex.Free;
  4264. end;
  4265. end;
  4266. {$ENDIF}
  4267. {$IFDEF GLB_LAZARUS}
  4268. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4269. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4270. var
  4271. rid: TRawImageDescription;
  4272. FormatDesc: TFormatDescriptor;
  4273. begin
  4274. result := false;
  4275. if not Assigned(aImage) or (Format = tfEmpty) then
  4276. exit;
  4277. FormatDesc := TFormatDescriptor.Get(Format);
  4278. if FormatDesc.IsCompressed then
  4279. exit;
  4280. FillChar(rid{%H-}, SizeOf(rid), 0);
  4281. if (Format in [
  4282. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  4283. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  4284. tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
  4285. rid.Format := ricfGray
  4286. else
  4287. rid.Format := ricfRGBA;
  4288. rid.Width := Width;
  4289. rid.Height := Height;
  4290. rid.Depth := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);
  4291. rid.BitOrder := riboBitsInOrder;
  4292. rid.ByteOrder := riboLSBFirst;
  4293. rid.LineOrder := riloTopToBottom;
  4294. rid.LineEnd := rileTight;
  4295. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4296. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4297. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4298. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4299. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4300. rid.RedShift := FormatDesc.Shift.r;
  4301. rid.GreenShift := FormatDesc.Shift.g;
  4302. rid.BlueShift := FormatDesc.Shift.b;
  4303. rid.AlphaShift := FormatDesc.Shift.a;
  4304. rid.MaskBitsPerPixel := 0;
  4305. rid.PaletteColorCount := 0;
  4306. aImage.DataDescription := rid;
  4307. aImage.CreateData;
  4308. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4309. result := true;
  4310. end;
  4311. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4312. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4313. var
  4314. f: TglBitmapFormat;
  4315. FormatDesc: TFormatDescriptor;
  4316. ImageData: PByte;
  4317. ImageSize: Integer;
  4318. begin
  4319. result := false;
  4320. if not Assigned(aImage) then
  4321. exit;
  4322. for f := High(f) downto Low(f) do begin
  4323. FormatDesc := TFormatDescriptor.Get(f);
  4324. with aImage.DataDescription do
  4325. if FormatDesc.MaskMatch(
  4326. (QWord(1 shl RedPrec )-1) shl RedShift,
  4327. (QWord(1 shl GreenPrec)-1) shl GreenShift,
  4328. (QWord(1 shl BluePrec )-1) shl BlueShift,
  4329. (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
  4330. break;
  4331. end;
  4332. if (f = tfEmpty) then
  4333. exit;
  4334. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4335. ImageData := GetMem(ImageSize);
  4336. try
  4337. Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
  4338. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4339. except
  4340. if Assigned(ImageData) then
  4341. FreeMem(ImageData);
  4342. raise;
  4343. end;
  4344. result := true;
  4345. end;
  4346. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4347. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4348. var
  4349. rid: TRawImageDescription;
  4350. FormatDesc: TFormatDescriptor;
  4351. Pixel: TglBitmapPixelData;
  4352. x, y: Integer;
  4353. srcMD: Pointer;
  4354. src, dst: PByte;
  4355. begin
  4356. result := false;
  4357. if not Assigned(aImage) or (Format = tfEmpty) then
  4358. exit;
  4359. FormatDesc := TFormatDescriptor.Get(Format);
  4360. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4361. exit;
  4362. FillChar(rid{%H-}, SizeOf(rid), 0);
  4363. rid.Format := ricfGray;
  4364. rid.Width := Width;
  4365. rid.Height := Height;
  4366. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4367. rid.BitOrder := riboBitsInOrder;
  4368. rid.ByteOrder := riboLSBFirst;
  4369. rid.LineOrder := riloTopToBottom;
  4370. rid.LineEnd := rileTight;
  4371. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4372. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4373. rid.GreenPrec := 0;
  4374. rid.BluePrec := 0;
  4375. rid.AlphaPrec := 0;
  4376. rid.RedShift := 0;
  4377. rid.GreenShift := 0;
  4378. rid.BlueShift := 0;
  4379. rid.AlphaShift := 0;
  4380. rid.MaskBitsPerPixel := 0;
  4381. rid.PaletteColorCount := 0;
  4382. aImage.DataDescription := rid;
  4383. aImage.CreateData;
  4384. srcMD := FormatDesc.CreateMappingData;
  4385. try
  4386. FormatDesc.PreparePixel(Pixel);
  4387. src := Data;
  4388. dst := aImage.PixelData;
  4389. for y := 0 to Height-1 do
  4390. for x := 0 to Width-1 do begin
  4391. FormatDesc.Unmap(src, Pixel, srcMD);
  4392. case rid.BitsPerPixel of
  4393. 8: begin
  4394. dst^ := Pixel.Data.a;
  4395. inc(dst);
  4396. end;
  4397. 16: begin
  4398. PWord(dst)^ := Pixel.Data.a;
  4399. inc(dst, 2);
  4400. end;
  4401. 24: begin
  4402. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4403. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4404. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4405. inc(dst, 3);
  4406. end;
  4407. 32: begin
  4408. PCardinal(dst)^ := Pixel.Data.a;
  4409. inc(dst, 4);
  4410. end;
  4411. else
  4412. raise EglBitmapUnsupportedFormat.Create(Format);
  4413. end;
  4414. end;
  4415. finally
  4416. FormatDesc.FreeMappingData(srcMD);
  4417. end;
  4418. result := true;
  4419. end;
  4420. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4421. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4422. var
  4423. tex: TglBitmap2D;
  4424. begin
  4425. tex := TglBitmap2D.Create;
  4426. try
  4427. tex.AssignFromLazIntfImage(aImage);
  4428. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4429. finally
  4430. tex.Free;
  4431. end;
  4432. end;
  4433. {$ENDIF}
  4434. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4435. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4436. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4437. var
  4438. rs: TResourceStream;
  4439. begin
  4440. PrepareResType(aResource, aResType);
  4441. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4442. try
  4443. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4444. finally
  4445. rs.Free;
  4446. end;
  4447. end;
  4448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4449. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4450. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4451. var
  4452. rs: TResourceStream;
  4453. begin
  4454. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4455. try
  4456. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4457. finally
  4458. rs.Free;
  4459. end;
  4460. end;
  4461. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4462. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4463. begin
  4464. if TFormatDescriptor.Get(Format).IsCompressed then
  4465. raise EglBitmapUnsupportedFormat.Create(Format);
  4466. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4467. end;
  4468. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4469. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4470. var
  4471. FS: TFileStream;
  4472. begin
  4473. FS := TFileStream.Create(aFileName, fmOpenRead);
  4474. try
  4475. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4476. finally
  4477. FS.Free;
  4478. end;
  4479. end;
  4480. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4481. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4482. var
  4483. tex: TglBitmap2D;
  4484. begin
  4485. tex := TglBitmap2D.Create(aStream);
  4486. try
  4487. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4488. finally
  4489. tex.Free;
  4490. end;
  4491. end;
  4492. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4493. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4494. var
  4495. DestData, DestData2, SourceData: pByte;
  4496. TempHeight, TempWidth: Integer;
  4497. SourceFD, DestFD: TFormatDescriptor;
  4498. SourceMD, DestMD, DestMD2: Pointer;
  4499. FuncRec: TglBitmapFunctionRec;
  4500. begin
  4501. result := false;
  4502. Assert(Assigned(Data));
  4503. Assert(Assigned(aBitmap));
  4504. Assert(Assigned(aBitmap.Data));
  4505. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4506. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4507. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4508. DestFD := TFormatDescriptor.Get(Format);
  4509. if not Assigned(aFunc) then begin
  4510. aFunc := glBitmapAlphaFunc;
  4511. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4512. end else
  4513. FuncRec.Args := aArgs;
  4514. // Values
  4515. TempHeight := aBitmap.FileHeight;
  4516. TempWidth := aBitmap.FileWidth;
  4517. FuncRec.Sender := Self;
  4518. FuncRec.Size := Dimension;
  4519. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4520. DestData := Data;
  4521. DestData2 := Data;
  4522. SourceData := aBitmap.Data;
  4523. // Mapping
  4524. SourceFD.PreparePixel(FuncRec.Source);
  4525. DestFD.PreparePixel (FuncRec.Dest);
  4526. SourceMD := SourceFD.CreateMappingData;
  4527. DestMD := DestFD.CreateMappingData;
  4528. DestMD2 := DestFD.CreateMappingData;
  4529. try
  4530. FuncRec.Position.Y := 0;
  4531. while FuncRec.Position.Y < TempHeight do begin
  4532. FuncRec.Position.X := 0;
  4533. while FuncRec.Position.X < TempWidth do begin
  4534. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4535. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4536. aFunc(FuncRec);
  4537. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4538. inc(FuncRec.Position.X);
  4539. end;
  4540. inc(FuncRec.Position.Y);
  4541. end;
  4542. finally
  4543. SourceFD.FreeMappingData(SourceMD);
  4544. DestFD.FreeMappingData(DestMD);
  4545. DestFD.FreeMappingData(DestMD2);
  4546. end;
  4547. end;
  4548. end;
  4549. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4550. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4551. begin
  4552. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4553. end;
  4554. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4555. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4556. var
  4557. PixelData: TglBitmapPixelData;
  4558. begin
  4559. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4560. result := AddAlphaFromColorKeyFloat(
  4561. aRed / PixelData.Range.r,
  4562. aGreen / PixelData.Range.g,
  4563. aBlue / PixelData.Range.b,
  4564. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4565. end;
  4566. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4567. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4568. var
  4569. values: array[0..2] of Single;
  4570. tmp: Cardinal;
  4571. i: Integer;
  4572. PixelData: TglBitmapPixelData;
  4573. begin
  4574. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4575. with PixelData do begin
  4576. values[0] := aRed;
  4577. values[1] := aGreen;
  4578. values[2] := aBlue;
  4579. for i := 0 to 2 do begin
  4580. tmp := Trunc(Range.arr[i] * aDeviation);
  4581. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4582. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4583. end;
  4584. Data.a := 0;
  4585. Range.a := 0;
  4586. end;
  4587. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4588. end;
  4589. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4590. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4591. begin
  4592. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4593. end;
  4594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4595. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4596. var
  4597. PixelData: TglBitmapPixelData;
  4598. begin
  4599. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4600. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4601. end;
  4602. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4603. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4604. var
  4605. PixelData: TglBitmapPixelData;
  4606. begin
  4607. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4608. with PixelData do
  4609. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4610. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4611. end;
  4612. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4613. function TglBitmap.RemoveAlpha: Boolean;
  4614. var
  4615. FormatDesc: TFormatDescriptor;
  4616. begin
  4617. result := false;
  4618. FormatDesc := TFormatDescriptor.Get(Format);
  4619. if Assigned(Data) then begin
  4620. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4621. raise EglBitmapUnsupportedFormat.Create(Format);
  4622. result := ConvertTo(FormatDesc.WithoutAlpha);
  4623. end;
  4624. end;
  4625. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4626. function TglBitmap.Clone: TglBitmap;
  4627. var
  4628. Temp: TglBitmap;
  4629. TempPtr: PByte;
  4630. Size: Integer;
  4631. begin
  4632. result := nil;
  4633. Temp := (ClassType.Create as TglBitmap);
  4634. try
  4635. // copy texture data if assigned
  4636. if Assigned(Data) then begin
  4637. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4638. GetMem(TempPtr, Size);
  4639. try
  4640. Move(Data^, TempPtr^, Size);
  4641. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4642. except
  4643. if Assigned(TempPtr) then
  4644. FreeMem(TempPtr);
  4645. raise;
  4646. end;
  4647. end else begin
  4648. TempPtr := nil;
  4649. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4650. end;
  4651. // copy properties
  4652. Temp.fID := ID;
  4653. Temp.fTarget := Target;
  4654. Temp.fFormat := Format;
  4655. Temp.fMipMap := MipMap;
  4656. Temp.fAnisotropic := Anisotropic;
  4657. Temp.fBorderColor := fBorderColor;
  4658. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4659. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4660. Temp.fFilterMin := fFilterMin;
  4661. Temp.fFilterMag := fFilterMag;
  4662. Temp.fWrapS := fWrapS;
  4663. Temp.fWrapT := fWrapT;
  4664. Temp.fWrapR := fWrapR;
  4665. Temp.fFilename := fFilename;
  4666. Temp.fCustomName := fCustomName;
  4667. Temp.fCustomNameW := fCustomNameW;
  4668. Temp.fCustomData := fCustomData;
  4669. result := Temp;
  4670. except
  4671. FreeAndNil(Temp);
  4672. raise;
  4673. end;
  4674. end;
  4675. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4676. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4677. var
  4678. SourceFD, DestFD: TFormatDescriptor;
  4679. SourcePD, DestPD: TglBitmapPixelData;
  4680. ShiftData: TShiftData;
  4681. function CanCopyDirect: Boolean;
  4682. begin
  4683. result :=
  4684. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4685. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4686. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4687. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4688. end;
  4689. function CanShift: Boolean;
  4690. begin
  4691. result :=
  4692. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4693. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4694. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4695. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4696. end;
  4697. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4698. begin
  4699. result := 0;
  4700. while (aSource > aDest) and (aSource > 0) do begin
  4701. inc(result);
  4702. aSource := aSource shr 1;
  4703. end;
  4704. end;
  4705. begin
  4706. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4707. SourceFD := TFormatDescriptor.Get(Format);
  4708. DestFD := TFormatDescriptor.Get(aFormat);
  4709. SourceFD.PreparePixel(SourcePD);
  4710. DestFD.PreparePixel (DestPD);
  4711. if CanCopyDirect then
  4712. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4713. else if CanShift then begin
  4714. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4715. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4716. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4717. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4718. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4719. end else
  4720. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4721. end else
  4722. result := true;
  4723. end;
  4724. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4725. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4726. begin
  4727. if aUseRGB or aUseAlpha then
  4728. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4729. ((PtrInt(aUseAlpha) and 1) shl 1) or
  4730. (PtrInt(aUseRGB) and 1) ));
  4731. end;
  4732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4733. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4734. begin
  4735. fBorderColor[0] := aRed;
  4736. fBorderColor[1] := aGreen;
  4737. fBorderColor[2] := aBlue;
  4738. fBorderColor[3] := aAlpha;
  4739. if (ID > 0) then begin
  4740. Bind(false);
  4741. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4742. end;
  4743. end;
  4744. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4745. procedure TglBitmap.FreeData;
  4746. var
  4747. TempPtr: PByte;
  4748. begin
  4749. TempPtr := nil;
  4750. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  4751. end;
  4752. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4753. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4754. const aAlpha: Byte);
  4755. begin
  4756. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4757. end;
  4758. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4759. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4760. var
  4761. PixelData: TglBitmapPixelData;
  4762. begin
  4763. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4764. FillWithColorFloat(
  4765. aRed / PixelData.Range.r,
  4766. aGreen / PixelData.Range.g,
  4767. aBlue / PixelData.Range.b,
  4768. aAlpha / PixelData.Range.a);
  4769. end;
  4770. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4771. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4772. var
  4773. PixelData: TglBitmapPixelData;
  4774. begin
  4775. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4776. with PixelData do begin
  4777. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4778. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4779. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4780. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4781. end;
  4782. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4783. end;
  4784. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4785. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  4786. begin
  4787. //check MIN filter
  4788. case aMin of
  4789. GL_NEAREST:
  4790. fFilterMin := GL_NEAREST;
  4791. GL_LINEAR:
  4792. fFilterMin := GL_LINEAR;
  4793. GL_NEAREST_MIPMAP_NEAREST:
  4794. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4795. GL_LINEAR_MIPMAP_NEAREST:
  4796. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4797. GL_NEAREST_MIPMAP_LINEAR:
  4798. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4799. GL_LINEAR_MIPMAP_LINEAR:
  4800. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4801. else
  4802. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  4803. end;
  4804. //check MAG filter
  4805. case aMag of
  4806. GL_NEAREST:
  4807. fFilterMag := GL_NEAREST;
  4808. GL_LINEAR:
  4809. fFilterMag := GL_LINEAR;
  4810. else
  4811. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  4812. end;
  4813. //apply filter
  4814. if (ID > 0) then begin
  4815. Bind(false);
  4816. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4817. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4818. case fFilterMin of
  4819. GL_NEAREST, GL_LINEAR:
  4820. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4821. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4822. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4823. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4824. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4825. end;
  4826. end else
  4827. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4828. end;
  4829. end;
  4830. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4831. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  4832. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4833. begin
  4834. case aValue of
  4835. GL_CLAMP:
  4836. aTarget := GL_CLAMP;
  4837. GL_REPEAT:
  4838. aTarget := GL_REPEAT;
  4839. GL_CLAMP_TO_EDGE: begin
  4840. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4841. aTarget := GL_CLAMP_TO_EDGE
  4842. else
  4843. aTarget := GL_CLAMP;
  4844. end;
  4845. GL_CLAMP_TO_BORDER: begin
  4846. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4847. aTarget := GL_CLAMP_TO_BORDER
  4848. else
  4849. aTarget := GL_CLAMP;
  4850. end;
  4851. GL_MIRRORED_REPEAT: begin
  4852. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4853. aTarget := GL_MIRRORED_REPEAT
  4854. else
  4855. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4856. end;
  4857. else
  4858. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  4859. end;
  4860. end;
  4861. begin
  4862. CheckAndSetWrap(S, fWrapS);
  4863. CheckAndSetWrap(T, fWrapT);
  4864. CheckAndSetWrap(R, fWrapR);
  4865. if (ID > 0) then begin
  4866. Bind(false);
  4867. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4868. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4869. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4870. end;
  4871. end;
  4872. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4873. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  4874. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  4875. begin
  4876. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  4877. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  4878. fSwizzle[aIndex] := aValue
  4879. else
  4880. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  4881. end;
  4882. begin
  4883. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4884. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  4885. CheckAndSetValue(r, 0);
  4886. CheckAndSetValue(g, 1);
  4887. CheckAndSetValue(b, 2);
  4888. CheckAndSetValue(a, 3);
  4889. if (ID > 0) then begin
  4890. Bind(false);
  4891. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
  4892. end;
  4893. end;
  4894. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4895. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4896. begin
  4897. if aEnableTextureUnit then
  4898. glEnable(Target);
  4899. if (ID > 0) then
  4900. glBindTexture(Target, ID);
  4901. end;
  4902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4903. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4904. begin
  4905. if aDisableTextureUnit then
  4906. glDisable(Target);
  4907. glBindTexture(Target, 0);
  4908. end;
  4909. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4910. constructor TglBitmap.Create;
  4911. begin
  4912. if (ClassType = TglBitmap) then
  4913. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4914. {$IFDEF GLB_NATIVE_OGL}
  4915. glbReadOpenGLExtensions;
  4916. {$ENDIF}
  4917. inherited Create;
  4918. end;
  4919. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4920. constructor TglBitmap.Create(const aFileName: String);
  4921. begin
  4922. Create;
  4923. LoadFromFile(aFileName);
  4924. end;
  4925. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4926. constructor TglBitmap.Create(const aStream: TStream);
  4927. begin
  4928. Create;
  4929. LoadFromStream(aStream);
  4930. end;
  4931. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4932. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
  4933. var
  4934. Image: PByte;
  4935. ImageSize: Integer;
  4936. begin
  4937. Create;
  4938. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4939. GetMem(Image, ImageSize);
  4940. try
  4941. FillChar(Image^, ImageSize, #$FF);
  4942. SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4943. except
  4944. if Assigned(Image) then
  4945. FreeMem(Image);
  4946. raise;
  4947. end;
  4948. end;
  4949. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4950. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
  4951. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  4952. begin
  4953. Create;
  4954. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  4955. end;
  4956. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4957. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  4958. begin
  4959. Create;
  4960. LoadFromResource(aInstance, aResource, aResType);
  4961. end;
  4962. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4963. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4964. begin
  4965. Create;
  4966. LoadFromResourceID(aInstance, aResourceID, aResType);
  4967. end;
  4968. {$IFDEF GLB_SUPPORT_PNG_READ}
  4969. {$IF DEFINED(GLB_LAZ_PNG)}
  4970. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4971. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4972. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4973. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4974. var
  4975. png: TPortableNetworkGraphic;
  4976. intf: TLazIntfImage;
  4977. StreamPos: Int64;
  4978. begin
  4979. result := true;
  4980. StreamPos := aStream.Position;
  4981. png := TPortableNetworkGraphic.Create;
  4982. try try
  4983. png.LoadFromStream(aStream);
  4984. intf := png.CreateIntfImage;
  4985. try try
  4986. AssignFromLazIntfImage(intf);
  4987. except
  4988. result := false;
  4989. aStream.Position := StreamPos;
  4990. exit;
  4991. end;
  4992. finally
  4993. intf.Free;
  4994. end;
  4995. except
  4996. result := false;
  4997. aStream.Position := StreamPos;
  4998. exit;
  4999. end;
  5000. finally
  5001. png.Free;
  5002. end;
  5003. end;
  5004. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5005. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5006. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5007. var
  5008. Surface: PSDL_Surface;
  5009. RWops: PSDL_RWops;
  5010. begin
  5011. result := false;
  5012. RWops := glBitmapCreateRWops(aStream);
  5013. try
  5014. if IMG_isPNG(RWops) > 0 then begin
  5015. Surface := IMG_LoadPNG_RW(RWops);
  5016. try
  5017. AssignFromSurface(Surface);
  5018. result := true;
  5019. finally
  5020. SDL_FreeSurface(Surface);
  5021. end;
  5022. end;
  5023. finally
  5024. SDL_FreeRW(RWops);
  5025. end;
  5026. end;
  5027. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5028. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5029. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5030. begin
  5031. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5032. end;
  5033. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5034. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5035. var
  5036. StreamPos: Int64;
  5037. signature: array [0..7] of byte;
  5038. png: png_structp;
  5039. png_info: png_infop;
  5040. TempHeight, TempWidth: Integer;
  5041. Format: TglBitmapFormat;
  5042. png_data: pByte;
  5043. png_rows: array of pByte;
  5044. Row, LineSize: Integer;
  5045. begin
  5046. result := false;
  5047. if not init_libPNG then
  5048. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5049. try
  5050. // signature
  5051. StreamPos := aStream.Position;
  5052. aStream.Read(signature{%H-}, 8);
  5053. aStream.Position := StreamPos;
  5054. if png_check_sig(@signature, 8) <> 0 then begin
  5055. // png read struct
  5056. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5057. if png = nil then
  5058. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5059. // png info
  5060. png_info := png_create_info_struct(png);
  5061. if png_info = nil then begin
  5062. png_destroy_read_struct(@png, nil, nil);
  5063. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5064. end;
  5065. // set read callback
  5066. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5067. // read informations
  5068. png_read_info(png, png_info);
  5069. // size
  5070. TempHeight := png_get_image_height(png, png_info);
  5071. TempWidth := png_get_image_width(png, png_info);
  5072. // format
  5073. case png_get_color_type(png, png_info) of
  5074. PNG_COLOR_TYPE_GRAY:
  5075. Format := tfLuminance8;
  5076. PNG_COLOR_TYPE_GRAY_ALPHA:
  5077. Format := tfLuminance8Alpha8;
  5078. PNG_COLOR_TYPE_RGB:
  5079. Format := tfRGB8;
  5080. PNG_COLOR_TYPE_RGB_ALPHA:
  5081. Format := tfRGBA8;
  5082. else
  5083. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5084. end;
  5085. // cut upper 8 bit from 16 bit formats
  5086. if png_get_bit_depth(png, png_info) > 8 then
  5087. png_set_strip_16(png);
  5088. // expand bitdepth smaller than 8
  5089. if png_get_bit_depth(png, png_info) < 8 then
  5090. png_set_expand(png);
  5091. // allocating mem for scanlines
  5092. LineSize := png_get_rowbytes(png, png_info);
  5093. GetMem(png_data, TempHeight * LineSize);
  5094. try
  5095. SetLength(png_rows, TempHeight);
  5096. for Row := Low(png_rows) to High(png_rows) do begin
  5097. png_rows[Row] := png_data;
  5098. Inc(png_rows[Row], Row * LineSize);
  5099. end;
  5100. // read complete image into scanlines
  5101. png_read_image(png, @png_rows[0]);
  5102. // read end
  5103. png_read_end(png, png_info);
  5104. // destroy read struct
  5105. png_destroy_read_struct(@png, @png_info, nil);
  5106. SetLength(png_rows, 0);
  5107. // set new data
  5108. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5109. result := true;
  5110. except
  5111. if Assigned(png_data) then
  5112. FreeMem(png_data);
  5113. raise;
  5114. end;
  5115. end;
  5116. finally
  5117. quit_libPNG;
  5118. end;
  5119. end;
  5120. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5121. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5122. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5123. var
  5124. StreamPos: Int64;
  5125. Png: TPNGObject;
  5126. Header: String[8];
  5127. Row, Col, PixSize, LineSize: Integer;
  5128. NewImage, pSource, pDest, pAlpha: pByte;
  5129. PngFormat: TglBitmapFormat;
  5130. FormatDesc: TFormatDescriptor;
  5131. const
  5132. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5133. begin
  5134. result := false;
  5135. StreamPos := aStream.Position;
  5136. aStream.Read(Header[0], SizeOf(Header));
  5137. aStream.Position := StreamPos;
  5138. {Test if the header matches}
  5139. if Header = PngHeader then begin
  5140. Png := TPNGObject.Create;
  5141. try
  5142. Png.LoadFromStream(aStream);
  5143. case Png.Header.ColorType of
  5144. COLOR_GRAYSCALE:
  5145. PngFormat := tfLuminance8;
  5146. COLOR_GRAYSCALEALPHA:
  5147. PngFormat := tfLuminance8Alpha8;
  5148. COLOR_RGB:
  5149. PngFormat := tfBGR8;
  5150. COLOR_RGBALPHA:
  5151. PngFormat := tfBGRA8;
  5152. else
  5153. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5154. end;
  5155. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5156. PixSize := Round(FormatDesc.PixelSize);
  5157. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5158. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5159. try
  5160. pDest := NewImage;
  5161. case Png.Header.ColorType of
  5162. COLOR_RGB, COLOR_GRAYSCALE:
  5163. begin
  5164. for Row := 0 to Png.Height -1 do begin
  5165. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5166. Inc(pDest, LineSize);
  5167. end;
  5168. end;
  5169. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5170. begin
  5171. PixSize := PixSize -1;
  5172. for Row := 0 to Png.Height -1 do begin
  5173. pSource := Png.Scanline[Row];
  5174. pAlpha := pByte(Png.AlphaScanline[Row]);
  5175. for Col := 0 to Png.Width -1 do begin
  5176. Move (pSource^, pDest^, PixSize);
  5177. Inc(pSource, PixSize);
  5178. Inc(pDest, PixSize);
  5179. pDest^ := pAlpha^;
  5180. inc(pAlpha);
  5181. Inc(pDest);
  5182. end;
  5183. end;
  5184. end;
  5185. else
  5186. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5187. end;
  5188. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5189. result := true;
  5190. except
  5191. if Assigned(NewImage) then
  5192. FreeMem(NewImage);
  5193. raise;
  5194. end;
  5195. finally
  5196. Png.Free;
  5197. end;
  5198. end;
  5199. end;
  5200. {$IFEND}
  5201. {$ENDIF}
  5202. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5203. {$IFDEF GLB_LIB_PNG}
  5204. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5205. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5206. begin
  5207. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5208. end;
  5209. {$ENDIF}
  5210. {$IF DEFINED(GLB_LAZ_PNG)}
  5211. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5212. procedure TglBitmap.SavePNG(const aStream: TStream);
  5213. var
  5214. png: TPortableNetworkGraphic;
  5215. intf: TLazIntfImage;
  5216. begin
  5217. png := TPortableNetworkGraphic.Create;
  5218. intf := TLazIntfImage.Create(0, 0);
  5219. try
  5220. if not AssignToLazIntfImage(intf) then
  5221. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5222. png.LoadFromIntfImage(intf);
  5223. png.SaveToStream(aStream);
  5224. finally
  5225. png.Free;
  5226. intf.Free;
  5227. end;
  5228. end;
  5229. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5230. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5231. procedure TglBitmap.SavePNG(const aStream: TStream);
  5232. var
  5233. png: png_structp;
  5234. png_info: png_infop;
  5235. png_rows: array of pByte;
  5236. LineSize: Integer;
  5237. ColorType: Integer;
  5238. Row: Integer;
  5239. FormatDesc: TFormatDescriptor;
  5240. begin
  5241. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5242. raise EglBitmapUnsupportedFormat.Create(Format);
  5243. if not init_libPNG then
  5244. raise Exception.Create('unable to initialize libPNG.');
  5245. try
  5246. case Format of
  5247. tfAlpha8, tfLuminance8:
  5248. ColorType := PNG_COLOR_TYPE_GRAY;
  5249. tfLuminance8Alpha8:
  5250. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5251. tfBGR8, tfRGB8:
  5252. ColorType := PNG_COLOR_TYPE_RGB;
  5253. tfBGRA8, tfRGBA8:
  5254. ColorType := PNG_COLOR_TYPE_RGBA;
  5255. else
  5256. raise EglBitmapUnsupportedFormat.Create(Format);
  5257. end;
  5258. FormatDesc := TFormatDescriptor.Get(Format);
  5259. LineSize := FormatDesc.GetSize(Width, 1);
  5260. // creating array for scanline
  5261. SetLength(png_rows, Height);
  5262. try
  5263. for Row := 0 to Height - 1 do begin
  5264. png_rows[Row] := Data;
  5265. Inc(png_rows[Row], Row * LineSize)
  5266. end;
  5267. // write struct
  5268. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5269. if png = nil then
  5270. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5271. // create png info
  5272. png_info := png_create_info_struct(png);
  5273. if png_info = nil then begin
  5274. png_destroy_write_struct(@png, nil);
  5275. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5276. end;
  5277. // set read callback
  5278. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5279. // set compression
  5280. png_set_compression_level(png, 6);
  5281. if Format in [tfBGR8, tfBGRA8] then
  5282. png_set_bgr(png);
  5283. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5284. png_write_info(png, png_info);
  5285. png_write_image(png, @png_rows[0]);
  5286. png_write_end(png, png_info);
  5287. png_destroy_write_struct(@png, @png_info);
  5288. finally
  5289. SetLength(png_rows, 0);
  5290. end;
  5291. finally
  5292. quit_libPNG;
  5293. end;
  5294. end;
  5295. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5296. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5297. procedure TglBitmap.SavePNG(const aStream: TStream);
  5298. var
  5299. Png: TPNGObject;
  5300. pSource, pDest: pByte;
  5301. X, Y, PixSize: Integer;
  5302. ColorType: Cardinal;
  5303. Alpha: Boolean;
  5304. pTemp: pByte;
  5305. Temp: Byte;
  5306. begin
  5307. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5308. raise EglBitmapUnsupportedFormat.Create(Format);
  5309. case Format of
  5310. tfAlpha8, tfLuminance8: begin
  5311. ColorType := COLOR_GRAYSCALE;
  5312. PixSize := 1;
  5313. Alpha := false;
  5314. end;
  5315. tfLuminance8Alpha8: begin
  5316. ColorType := COLOR_GRAYSCALEALPHA;
  5317. PixSize := 1;
  5318. Alpha := true;
  5319. end;
  5320. tfBGR8, tfRGB8: begin
  5321. ColorType := COLOR_RGB;
  5322. PixSize := 3;
  5323. Alpha := false;
  5324. end;
  5325. tfBGRA8, tfRGBA8: begin
  5326. ColorType := COLOR_RGBALPHA;
  5327. PixSize := 3;
  5328. Alpha := true
  5329. end;
  5330. else
  5331. raise EglBitmapUnsupportedFormat.Create(Format);
  5332. end;
  5333. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5334. try
  5335. // Copy ImageData
  5336. pSource := Data;
  5337. for Y := 0 to Height -1 do begin
  5338. pDest := png.ScanLine[Y];
  5339. for X := 0 to Width -1 do begin
  5340. Move(pSource^, pDest^, PixSize);
  5341. Inc(pDest, PixSize);
  5342. Inc(pSource, PixSize);
  5343. if Alpha then begin
  5344. png.AlphaScanline[Y]^[X] := pSource^;
  5345. Inc(pSource);
  5346. end;
  5347. end;
  5348. // convert RGB line to BGR
  5349. if Format in [tfRGB8, tfRGBA8] then begin
  5350. pTemp := png.ScanLine[Y];
  5351. for X := 0 to Width -1 do begin
  5352. Temp := pByteArray(pTemp)^[0];
  5353. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5354. pByteArray(pTemp)^[2] := Temp;
  5355. Inc(pTemp, 3);
  5356. end;
  5357. end;
  5358. end;
  5359. // Save to Stream
  5360. Png.CompressionLevel := 6;
  5361. Png.SaveToStream(aStream);
  5362. finally
  5363. FreeAndNil(Png);
  5364. end;
  5365. end;
  5366. {$IFEND}
  5367. {$ENDIF}
  5368. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5369. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5370. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5371. {$IFDEF GLB_LIB_JPEG}
  5372. type
  5373. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5374. glBitmap_libJPEG_source_mgr = record
  5375. pub: jpeg_source_mgr;
  5376. SrcStream: TStream;
  5377. SrcBuffer: array [1..4096] of byte;
  5378. end;
  5379. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5380. glBitmap_libJPEG_dest_mgr = record
  5381. pub: jpeg_destination_mgr;
  5382. DestStream: TStream;
  5383. DestBuffer: array [1..4096] of byte;
  5384. end;
  5385. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5386. begin
  5387. //DUMMY
  5388. end;
  5389. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5390. begin
  5391. //DUMMY
  5392. end;
  5393. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5394. begin
  5395. //DUMMY
  5396. end;
  5397. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5398. begin
  5399. //DUMMY
  5400. end;
  5401. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5402. begin
  5403. //DUMMY
  5404. end;
  5405. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5406. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5407. var
  5408. src: glBitmap_libJPEG_source_mgr_ptr;
  5409. bytes: integer;
  5410. begin
  5411. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5412. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5413. if (bytes <= 0) then begin
  5414. src^.SrcBuffer[1] := $FF;
  5415. src^.SrcBuffer[2] := JPEG_EOI;
  5416. bytes := 2;
  5417. end;
  5418. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5419. src^.pub.bytes_in_buffer := bytes;
  5420. result := true;
  5421. end;
  5422. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5423. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5424. var
  5425. src: glBitmap_libJPEG_source_mgr_ptr;
  5426. begin
  5427. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5428. if num_bytes > 0 then begin
  5429. // wanted byte isn't in buffer so set stream position and read buffer
  5430. if num_bytes > src^.pub.bytes_in_buffer then begin
  5431. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5432. src^.pub.fill_input_buffer(cinfo);
  5433. end else begin
  5434. // wanted byte is in buffer so only skip
  5435. inc(src^.pub.next_input_byte, num_bytes);
  5436. dec(src^.pub.bytes_in_buffer, num_bytes);
  5437. end;
  5438. end;
  5439. end;
  5440. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5441. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5442. var
  5443. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5444. begin
  5445. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5446. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5447. // write complete buffer
  5448. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5449. // reset buffer
  5450. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5451. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5452. end;
  5453. result := true;
  5454. end;
  5455. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5456. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5457. var
  5458. Idx: Integer;
  5459. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5460. begin
  5461. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5462. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5463. // check for endblock
  5464. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5465. // write endblock
  5466. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5467. // leave
  5468. break;
  5469. end else
  5470. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5471. end;
  5472. end;
  5473. {$ENDIF}
  5474. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5475. {$IF DEFINED(GLB_LAZ_JPEG)}
  5476. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5477. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5478. var
  5479. jpeg: TJPEGImage;
  5480. intf: TLazIntfImage;
  5481. StreamPos: Int64;
  5482. begin
  5483. result := true;
  5484. StreamPos := aStream.Position;
  5485. jpeg := TJPEGImage.Create;
  5486. try try
  5487. jpeg.LoadFromStream(aStream);
  5488. intf := TLazIntfImage.Create(0, 0);
  5489. try try
  5490. intf.LoadFromBitmap(jpeg.BitmapHandle, jpeg.MaskHandle);
  5491. AssignFromLazIntfImage(intf);
  5492. except
  5493. result := false;
  5494. aStream.Position := StreamPos;
  5495. exit;
  5496. end;
  5497. finally
  5498. intf.Free;
  5499. end;
  5500. except
  5501. result := false;
  5502. aStream.Position := StreamPos;
  5503. exit;
  5504. end;
  5505. finally
  5506. jpeg.Free;
  5507. end;
  5508. end;
  5509. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5510. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5511. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5512. var
  5513. Surface: PSDL_Surface;
  5514. RWops: PSDL_RWops;
  5515. begin
  5516. result := false;
  5517. RWops := glBitmapCreateRWops(aStream);
  5518. try
  5519. if IMG_isJPG(RWops) > 0 then begin
  5520. Surface := IMG_LoadJPG_RW(RWops);
  5521. try
  5522. AssignFromSurface(Surface);
  5523. result := true;
  5524. finally
  5525. SDL_FreeSurface(Surface);
  5526. end;
  5527. end;
  5528. finally
  5529. SDL_FreeRW(RWops);
  5530. end;
  5531. end;
  5532. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5533. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5534. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5535. var
  5536. StreamPos: Int64;
  5537. Temp: array[0..1]of Byte;
  5538. jpeg: jpeg_decompress_struct;
  5539. jpeg_err: jpeg_error_mgr;
  5540. IntFormat: TglBitmapFormat;
  5541. pImage: pByte;
  5542. TempHeight, TempWidth: Integer;
  5543. pTemp: pByte;
  5544. Row: Integer;
  5545. FormatDesc: TFormatDescriptor;
  5546. begin
  5547. result := false;
  5548. if not init_libJPEG then
  5549. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5550. try
  5551. // reading first two bytes to test file and set cursor back to begin
  5552. StreamPos := aStream.Position;
  5553. aStream.Read({%H-}Temp[0], 2);
  5554. aStream.Position := StreamPos;
  5555. // if Bitmap then read file.
  5556. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5557. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5558. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5559. // error managment
  5560. jpeg.err := jpeg_std_error(@jpeg_err);
  5561. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5562. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5563. // decompression struct
  5564. jpeg_create_decompress(@jpeg);
  5565. // allocation space for streaming methods
  5566. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5567. // seeting up custom functions
  5568. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5569. pub.init_source := glBitmap_libJPEG_init_source;
  5570. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5571. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5572. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5573. pub.term_source := glBitmap_libJPEG_term_source;
  5574. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5575. pub.next_input_byte := nil; // until buffer loaded
  5576. SrcStream := aStream;
  5577. end;
  5578. // set global decoding state
  5579. jpeg.global_state := DSTATE_START;
  5580. // read header of jpeg
  5581. jpeg_read_header(@jpeg, false);
  5582. // setting output parameter
  5583. case jpeg.jpeg_color_space of
  5584. JCS_GRAYSCALE:
  5585. begin
  5586. jpeg.out_color_space := JCS_GRAYSCALE;
  5587. IntFormat := tfLuminance8;
  5588. end;
  5589. else
  5590. jpeg.out_color_space := JCS_RGB;
  5591. IntFormat := tfRGB8;
  5592. end;
  5593. // reading image
  5594. jpeg_start_decompress(@jpeg);
  5595. TempHeight := jpeg.output_height;
  5596. TempWidth := jpeg.output_width;
  5597. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5598. // creating new image
  5599. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5600. try
  5601. pTemp := pImage;
  5602. for Row := 0 to TempHeight -1 do begin
  5603. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5604. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5605. end;
  5606. // finish decompression
  5607. jpeg_finish_decompress(@jpeg);
  5608. // destroy decompression
  5609. jpeg_destroy_decompress(@jpeg);
  5610. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5611. result := true;
  5612. except
  5613. if Assigned(pImage) then
  5614. FreeMem(pImage);
  5615. raise;
  5616. end;
  5617. end;
  5618. finally
  5619. quit_libJPEG;
  5620. end;
  5621. end;
  5622. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5623. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5624. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5625. var
  5626. bmp: TBitmap;
  5627. jpg: TJPEGImage;
  5628. StreamPos: Int64;
  5629. Temp: array[0..1]of Byte;
  5630. begin
  5631. result := false;
  5632. // reading first two bytes to test file and set cursor back to begin
  5633. StreamPos := aStream.Position;
  5634. aStream.Read(Temp[0], 2);
  5635. aStream.Position := StreamPos;
  5636. // if Bitmap then read file.
  5637. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5638. bmp := TBitmap.Create;
  5639. try
  5640. jpg := TJPEGImage.Create;
  5641. try
  5642. jpg.LoadFromStream(aStream);
  5643. bmp.Assign(jpg);
  5644. result := AssignFromBitmap(bmp);
  5645. finally
  5646. jpg.Free;
  5647. end;
  5648. finally
  5649. bmp.Free;
  5650. end;
  5651. end;
  5652. end;
  5653. {$IFEND}
  5654. {$ENDIF}
  5655. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5656. {$IF DEFINED(GLB_LAZ_JPEG)}
  5657. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5658. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5659. var
  5660. jpeg: TJPEGImage;
  5661. intf: TLazIntfImage;
  5662. begin
  5663. jpeg := TJPEGImage.Create;
  5664. intf := TLazIntfImage.Create(0, 0);
  5665. try
  5666. if not AssignToLazIntfImage(intf) then
  5667. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5668. jpeg.LoadFromIntfImage(intf);
  5669. jpeg.SaveToStream(aStream);
  5670. finally
  5671. intf.Free;
  5672. jpeg.Free;
  5673. end;
  5674. end;
  5675. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5676. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5677. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5678. var
  5679. jpeg: jpeg_compress_struct;
  5680. jpeg_err: jpeg_error_mgr;
  5681. Row: Integer;
  5682. pTemp, pTemp2: pByte;
  5683. procedure CopyRow(pDest, pSource: pByte);
  5684. var
  5685. X: Integer;
  5686. begin
  5687. for X := 0 to Width - 1 do begin
  5688. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5689. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5690. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5691. Inc(pDest, 3);
  5692. Inc(pSource, 3);
  5693. end;
  5694. end;
  5695. begin
  5696. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5697. raise EglBitmapUnsupportedFormat.Create(Format);
  5698. if not init_libJPEG then
  5699. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5700. try
  5701. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  5702. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5703. // error managment
  5704. jpeg.err := jpeg_std_error(@jpeg_err);
  5705. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5706. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5707. // compression struct
  5708. jpeg_create_compress(@jpeg);
  5709. // allocation space for streaming methods
  5710. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5711. // seeting up custom functions
  5712. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5713. pub.init_destination := glBitmap_libJPEG_init_destination;
  5714. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5715. pub.term_destination := glBitmap_libJPEG_term_destination;
  5716. pub.next_output_byte := @DestBuffer[1];
  5717. pub.free_in_buffer := Length(DestBuffer);
  5718. DestStream := aStream;
  5719. end;
  5720. // very important state
  5721. jpeg.global_state := CSTATE_START;
  5722. jpeg.image_width := Width;
  5723. jpeg.image_height := Height;
  5724. case Format of
  5725. tfAlpha8, tfLuminance8: begin
  5726. jpeg.input_components := 1;
  5727. jpeg.in_color_space := JCS_GRAYSCALE;
  5728. end;
  5729. tfRGB8, tfBGR8: begin
  5730. jpeg.input_components := 3;
  5731. jpeg.in_color_space := JCS_RGB;
  5732. end;
  5733. end;
  5734. jpeg_set_defaults(@jpeg);
  5735. jpeg_set_quality(@jpeg, 95, true);
  5736. jpeg_start_compress(@jpeg, true);
  5737. pTemp := Data;
  5738. if Format = tfBGR8 then
  5739. GetMem(pTemp2, fRowSize)
  5740. else
  5741. pTemp2 := pTemp;
  5742. try
  5743. for Row := 0 to jpeg.image_height -1 do begin
  5744. // prepare row
  5745. if Format = tfBGR8 then
  5746. CopyRow(pTemp2, pTemp)
  5747. else
  5748. pTemp2 := pTemp;
  5749. // write row
  5750. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5751. inc(pTemp, fRowSize);
  5752. end;
  5753. finally
  5754. // free memory
  5755. if Format = tfBGR8 then
  5756. FreeMem(pTemp2);
  5757. end;
  5758. jpeg_finish_compress(@jpeg);
  5759. jpeg_destroy_compress(@jpeg);
  5760. finally
  5761. quit_libJPEG;
  5762. end;
  5763. end;
  5764. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5766. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5767. var
  5768. Bmp: TBitmap;
  5769. Jpg: TJPEGImage;
  5770. begin
  5771. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5772. raise EglBitmapUnsupportedFormat.Create(Format);
  5773. Bmp := TBitmap.Create;
  5774. try
  5775. Jpg := TJPEGImage.Create;
  5776. try
  5777. AssignToBitmap(Bmp);
  5778. if (Format in [tfAlpha8, tfLuminance8]) then begin
  5779. Jpg.Grayscale := true;
  5780. Jpg.PixelFormat := jf8Bit;
  5781. end;
  5782. Jpg.Assign(Bmp);
  5783. Jpg.SaveToStream(aStream);
  5784. finally
  5785. FreeAndNil(Jpg);
  5786. end;
  5787. finally
  5788. FreeAndNil(Bmp);
  5789. end;
  5790. end;
  5791. {$IFEND}
  5792. {$ENDIF}
  5793. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5794. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5795. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5796. const
  5797. BMP_MAGIC = $4D42;
  5798. BMP_COMP_RGB = 0;
  5799. BMP_COMP_RLE8 = 1;
  5800. BMP_COMP_RLE4 = 2;
  5801. BMP_COMP_BITFIELDS = 3;
  5802. type
  5803. TBMPHeader = packed record
  5804. bfType: Word;
  5805. bfSize: Cardinal;
  5806. bfReserved1: Word;
  5807. bfReserved2: Word;
  5808. bfOffBits: Cardinal;
  5809. end;
  5810. TBMPInfo = packed record
  5811. biSize: Cardinal;
  5812. biWidth: Longint;
  5813. biHeight: Longint;
  5814. biPlanes: Word;
  5815. biBitCount: Word;
  5816. biCompression: Cardinal;
  5817. biSizeImage: Cardinal;
  5818. biXPelsPerMeter: Longint;
  5819. biYPelsPerMeter: Longint;
  5820. biClrUsed: Cardinal;
  5821. biClrImportant: Cardinal;
  5822. end;
  5823. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5824. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5825. //////////////////////////////////////////////////////////////////////////////////////////////////
  5826. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5827. begin
  5828. result := tfEmpty;
  5829. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5830. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5831. //Read Compression
  5832. case aInfo.biCompression of
  5833. BMP_COMP_RLE4,
  5834. BMP_COMP_RLE8: begin
  5835. raise EglBitmap.Create('RLE compression is not supported');
  5836. end;
  5837. BMP_COMP_BITFIELDS: begin
  5838. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5839. aStream.Read(aMask.r, SizeOf(aMask.r));
  5840. aStream.Read(aMask.g, SizeOf(aMask.g));
  5841. aStream.Read(aMask.b, SizeOf(aMask.b));
  5842. aStream.Read(aMask.a, SizeOf(aMask.a));
  5843. end else
  5844. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  5845. end;
  5846. end;
  5847. //get suitable format
  5848. case aInfo.biBitCount of
  5849. 8: result := tfLuminance8;
  5850. 16: result := tfBGR5;
  5851. 24: result := tfBGR8;
  5852. 32: result := tfBGRA8;
  5853. end;
  5854. end;
  5855. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5856. var
  5857. i, c: Integer;
  5858. ColorTable: TbmpColorTable;
  5859. begin
  5860. result := nil;
  5861. if (aInfo.biBitCount >= 16) then
  5862. exit;
  5863. aFormat := tfLuminance8;
  5864. c := aInfo.biClrUsed;
  5865. if (c = 0) then
  5866. c := 1 shl aInfo.biBitCount;
  5867. SetLength(ColorTable, c);
  5868. for i := 0 to c-1 do begin
  5869. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5870. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5871. aFormat := tfRGB8;
  5872. end;
  5873. result := TbmpColorTableFormat.Create;
  5874. result.PixelSize := aInfo.biBitCount / 8;
  5875. result.ColorTable := ColorTable;
  5876. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5877. end;
  5878. //////////////////////////////////////////////////////////////////////////////////////////////////
  5879. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5880. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5881. var
  5882. TmpFormat: TglBitmapFormat;
  5883. FormatDesc: TFormatDescriptor;
  5884. begin
  5885. result := nil;
  5886. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5887. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5888. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5889. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5890. aFormat := FormatDesc.Format;
  5891. exit;
  5892. end;
  5893. end;
  5894. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5895. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5896. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5897. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5898. result := TbmpBitfieldFormat.Create;
  5899. result.PixelSize := aInfo.biBitCount / 8;
  5900. result.RedMask := aMask.r;
  5901. result.GreenMask := aMask.g;
  5902. result.BlueMask := aMask.b;
  5903. result.AlphaMask := aMask.a;
  5904. end;
  5905. end;
  5906. var
  5907. //simple types
  5908. StartPos: Int64;
  5909. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5910. PaddingBuff: Cardinal;
  5911. LineBuf, ImageData, TmpData: PByte;
  5912. SourceMD, DestMD: Pointer;
  5913. BmpFormat: TglBitmapFormat;
  5914. //records
  5915. Mask: TglBitmapColorRec;
  5916. Header: TBMPHeader;
  5917. Info: TBMPInfo;
  5918. //classes
  5919. SpecialFormat: TFormatDescriptor;
  5920. FormatDesc: TFormatDescriptor;
  5921. //////////////////////////////////////////////////////////////////////////////////////////////////
  5922. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  5923. var
  5924. i: Integer;
  5925. Pixel: TglBitmapPixelData;
  5926. begin
  5927. aStream.Read(aLineBuf^, rbLineSize);
  5928. SpecialFormat.PreparePixel(Pixel);
  5929. for i := 0 to Info.biWidth-1 do begin
  5930. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  5931. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  5932. FormatDesc.Map(Pixel, aData, DestMD);
  5933. end;
  5934. end;
  5935. begin
  5936. result := false;
  5937. BmpFormat := tfEmpty;
  5938. SpecialFormat := nil;
  5939. LineBuf := nil;
  5940. SourceMD := nil;
  5941. DestMD := nil;
  5942. // Header
  5943. StartPos := aStream.Position;
  5944. aStream.Read(Header{%H-}, SizeOf(Header));
  5945. if Header.bfType = BMP_MAGIC then begin
  5946. try try
  5947. BmpFormat := ReadInfo(Info, Mask);
  5948. SpecialFormat := ReadColorTable(BmpFormat, Info);
  5949. if not Assigned(SpecialFormat) then
  5950. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  5951. aStream.Position := StartPos + Header.bfOffBits;
  5952. if (BmpFormat <> tfEmpty) then begin
  5953. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  5954. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  5955. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  5956. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  5957. //get Memory
  5958. DestMD := FormatDesc.CreateMappingData;
  5959. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  5960. GetMem(ImageData, ImageSize);
  5961. if Assigned(SpecialFormat) then begin
  5962. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  5963. SourceMD := SpecialFormat.CreateMappingData;
  5964. end;
  5965. //read Data
  5966. try try
  5967. FillChar(ImageData^, ImageSize, $FF);
  5968. TmpData := ImageData;
  5969. if (Info.biHeight > 0) then
  5970. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  5971. for i := 0 to Abs(Info.biHeight)-1 do begin
  5972. if Assigned(SpecialFormat) then
  5973. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  5974. else
  5975. aStream.Read(TmpData^, wbLineSize); //else only read data
  5976. if (Info.biHeight > 0) then
  5977. dec(TmpData, wbLineSize)
  5978. else
  5979. inc(TmpData, wbLineSize);
  5980. aStream.Read(PaddingBuff{%H-}, Padding);
  5981. end;
  5982. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  5983. result := true;
  5984. finally
  5985. if Assigned(LineBuf) then
  5986. FreeMem(LineBuf);
  5987. if Assigned(SourceMD) then
  5988. SpecialFormat.FreeMappingData(SourceMD);
  5989. FormatDesc.FreeMappingData(DestMD);
  5990. end;
  5991. except
  5992. if Assigned(ImageData) then
  5993. FreeMem(ImageData);
  5994. raise;
  5995. end;
  5996. end else
  5997. raise EglBitmap.Create('LoadBMP - No suitable format found');
  5998. except
  5999. aStream.Position := StartPos;
  6000. raise;
  6001. end;
  6002. finally
  6003. FreeAndNil(SpecialFormat);
  6004. end;
  6005. end
  6006. else aStream.Position := StartPos;
  6007. end;
  6008. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6009. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6010. var
  6011. Header: TBMPHeader;
  6012. Info: TBMPInfo;
  6013. Converter: TbmpColorTableFormat;
  6014. FormatDesc: TFormatDescriptor;
  6015. SourceFD, DestFD: Pointer;
  6016. pData, srcData, dstData, ConvertBuffer: pByte;
  6017. Pixel: TglBitmapPixelData;
  6018. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6019. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6020. PaddingBuff: Cardinal;
  6021. function GetLineWidth : Integer;
  6022. begin
  6023. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6024. end;
  6025. begin
  6026. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6027. raise EglBitmapUnsupportedFormat.Create(Format);
  6028. Converter := nil;
  6029. FormatDesc := TFormatDescriptor.Get(Format);
  6030. ImageSize := FormatDesc.GetSize(Dimension);
  6031. FillChar(Header{%H-}, SizeOf(Header), 0);
  6032. Header.bfType := BMP_MAGIC;
  6033. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6034. Header.bfReserved1 := 0;
  6035. Header.bfReserved2 := 0;
  6036. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6037. FillChar(Info{%H-}, SizeOf(Info), 0);
  6038. Info.biSize := SizeOf(Info);
  6039. Info.biWidth := Width;
  6040. Info.biHeight := Height;
  6041. Info.biPlanes := 1;
  6042. Info.biCompression := BMP_COMP_RGB;
  6043. Info.biSizeImage := ImageSize;
  6044. try
  6045. case Format of
  6046. tfLuminance4: begin
  6047. Info.biBitCount := 4;
  6048. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  6049. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  6050. Converter := TbmpColorTableFormat.Create;
  6051. Converter.PixelSize := 0.5;
  6052. Converter.Format := Format;
  6053. Converter.Range := glBitmapColorRec($F, $F, $F, $0);
  6054. Converter.CreateColorTable;
  6055. end;
  6056. tfR3G3B2, tfLuminance8: begin
  6057. Info.biBitCount := 8;
  6058. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6059. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6060. Converter := TbmpColorTableFormat.Create;
  6061. Converter.PixelSize := 1;
  6062. Converter.Format := Format;
  6063. if (Format = tfR3G3B2) then begin
  6064. Converter.Range := glBitmapColorRec($7, $7, $3, $0);
  6065. Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
  6066. end else
  6067. Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
  6068. Converter.CreateColorTable;
  6069. end;
  6070. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  6071. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  6072. Info.biBitCount := 16;
  6073. Info.biCompression := BMP_COMP_BITFIELDS;
  6074. end;
  6075. tfBGR8, tfRGB8: begin
  6076. Info.biBitCount := 24;
  6077. end;
  6078. tfRGB10, tfRGB10A2, tfRGBA8,
  6079. tfBGR10, tfBGR10A2, tfBGRA8: begin
  6080. Info.biBitCount := 32;
  6081. Info.biCompression := BMP_COMP_BITFIELDS;
  6082. end;
  6083. else
  6084. raise EglBitmapUnsupportedFormat.Create(Format);
  6085. end;
  6086. Info.biXPelsPerMeter := 2835;
  6087. Info.biYPelsPerMeter := 2835;
  6088. // prepare bitmasks
  6089. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6090. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6091. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6092. RedMask := FormatDesc.RedMask;
  6093. GreenMask := FormatDesc.GreenMask;
  6094. BlueMask := FormatDesc.BlueMask;
  6095. AlphaMask := FormatDesc.AlphaMask;
  6096. end;
  6097. // headers
  6098. aStream.Write(Header, SizeOf(Header));
  6099. aStream.Write(Info, SizeOf(Info));
  6100. // colortable
  6101. if Assigned(Converter) then
  6102. aStream.Write(Converter.ColorTable[0].b,
  6103. SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
  6104. // bitmasks
  6105. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6106. aStream.Write(RedMask, SizeOf(Cardinal));
  6107. aStream.Write(GreenMask, SizeOf(Cardinal));
  6108. aStream.Write(BlueMask, SizeOf(Cardinal));
  6109. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6110. end;
  6111. // image data
  6112. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  6113. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6114. Padding := GetLineWidth - wbLineSize;
  6115. PaddingBuff := 0;
  6116. pData := Data;
  6117. inc(pData, (Height-1) * rbLineSize);
  6118. // prepare row buffer. But only for RGB because RGBA supports color masks
  6119. // so it's possible to change color within the image.
  6120. if Assigned(Converter) then begin
  6121. FormatDesc.PreparePixel(Pixel);
  6122. GetMem(ConvertBuffer, wbLineSize);
  6123. SourceFD := FormatDesc.CreateMappingData;
  6124. DestFD := Converter.CreateMappingData;
  6125. end else
  6126. ConvertBuffer := nil;
  6127. try
  6128. for LineIdx := 0 to Height - 1 do begin
  6129. // preparing row
  6130. if Assigned(Converter) then begin
  6131. srcData := pData;
  6132. dstData := ConvertBuffer;
  6133. for PixelIdx := 0 to Info.biWidth-1 do begin
  6134. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6135. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6136. Converter.Map(Pixel, dstData, DestFD);
  6137. end;
  6138. aStream.Write(ConvertBuffer^, wbLineSize);
  6139. end else begin
  6140. aStream.Write(pData^, rbLineSize);
  6141. end;
  6142. dec(pData, rbLineSize);
  6143. if (Padding > 0) then
  6144. aStream.Write(PaddingBuff, Padding);
  6145. end;
  6146. finally
  6147. // destroy row buffer
  6148. if Assigned(ConvertBuffer) then begin
  6149. FormatDesc.FreeMappingData(SourceFD);
  6150. Converter.FreeMappingData(DestFD);
  6151. FreeMem(ConvertBuffer);
  6152. end;
  6153. end;
  6154. finally
  6155. if Assigned(Converter) then
  6156. Converter.Free;
  6157. end;
  6158. end;
  6159. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6160. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6161. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6162. type
  6163. TTGAHeader = packed record
  6164. ImageID: Byte;
  6165. ColorMapType: Byte;
  6166. ImageType: Byte;
  6167. //ColorMapSpec: Array[0..4] of Byte;
  6168. ColorMapStart: Word;
  6169. ColorMapLength: Word;
  6170. ColorMapEntrySize: Byte;
  6171. OrigX: Word;
  6172. OrigY: Word;
  6173. Width: Word;
  6174. Height: Word;
  6175. Bpp: Byte;
  6176. ImageDesc: Byte;
  6177. end;
  6178. const
  6179. TGA_UNCOMPRESSED_RGB = 2;
  6180. TGA_UNCOMPRESSED_GRAY = 3;
  6181. TGA_COMPRESSED_RGB = 10;
  6182. TGA_COMPRESSED_GRAY = 11;
  6183. TGA_NONE_COLOR_TABLE = 0;
  6184. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6185. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6186. var
  6187. Header: TTGAHeader;
  6188. ImageData: System.PByte;
  6189. StartPosition: Int64;
  6190. PixelSize, LineSize: Integer;
  6191. tgaFormat: TglBitmapFormat;
  6192. FormatDesc: TFormatDescriptor;
  6193. Counter: packed record
  6194. X, Y: packed record
  6195. low, high, dir: Integer;
  6196. end;
  6197. end;
  6198. const
  6199. CACHE_SIZE = $4000;
  6200. ////////////////////////////////////////////////////////////////////////////////////////
  6201. procedure ReadUncompressed;
  6202. var
  6203. i, j: Integer;
  6204. buf, tmp1, tmp2: System.PByte;
  6205. begin
  6206. buf := nil;
  6207. if (Counter.X.dir < 0) then
  6208. GetMem(buf, LineSize);
  6209. try
  6210. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6211. tmp1 := ImageData;
  6212. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6213. if (Counter.X.dir < 0) then begin //flip X
  6214. aStream.Read(buf^, LineSize);
  6215. tmp2 := buf;
  6216. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6217. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6218. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6219. tmp1^ := tmp2^;
  6220. inc(tmp1);
  6221. inc(tmp2);
  6222. end;
  6223. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6224. end;
  6225. end else
  6226. aStream.Read(tmp1^, LineSize);
  6227. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6228. end;
  6229. finally
  6230. if Assigned(buf) then
  6231. FreeMem(buf);
  6232. end;
  6233. end;
  6234. ////////////////////////////////////////////////////////////////////////////////////////
  6235. procedure ReadCompressed;
  6236. /////////////////////////////////////////////////////////////////
  6237. var
  6238. TmpData: System.PByte;
  6239. LinePixelsRead: Integer;
  6240. procedure CheckLine;
  6241. begin
  6242. if (LinePixelsRead >= Header.Width) then begin
  6243. LinePixelsRead := 0;
  6244. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6245. TmpData := ImageData;
  6246. inc(TmpData, Counter.Y.low * LineSize); //set line
  6247. if (Counter.X.dir < 0) then //if x flipped then
  6248. inc(TmpData, LineSize - PixelSize); //set last pixel
  6249. end;
  6250. end;
  6251. /////////////////////////////////////////////////////////////////
  6252. var
  6253. Cache: PByte;
  6254. CacheSize, CachePos: Integer;
  6255. procedure CachedRead(out Buffer; Count: Integer);
  6256. var
  6257. BytesRead: Integer;
  6258. begin
  6259. if (CachePos + Count > CacheSize) then begin
  6260. //if buffer overflow save non read bytes
  6261. BytesRead := 0;
  6262. if (CacheSize - CachePos > 0) then begin
  6263. BytesRead := CacheSize - CachePos;
  6264. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6265. inc(CachePos, BytesRead);
  6266. end;
  6267. //load cache from file
  6268. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6269. aStream.Read(Cache^, CacheSize);
  6270. CachePos := 0;
  6271. //read rest of requested bytes
  6272. if (Count - BytesRead > 0) then begin
  6273. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6274. inc(CachePos, Count - BytesRead);
  6275. end;
  6276. end else begin
  6277. //if no buffer overflow just read the data
  6278. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6279. inc(CachePos, Count);
  6280. end;
  6281. end;
  6282. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6283. begin
  6284. case PixelSize of
  6285. 1: begin
  6286. aBuffer^ := aData^;
  6287. inc(aBuffer, Counter.X.dir);
  6288. end;
  6289. 2: begin
  6290. PWord(aBuffer)^ := PWord(aData)^;
  6291. inc(aBuffer, 2 * Counter.X.dir);
  6292. end;
  6293. 3: begin
  6294. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6295. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6296. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6297. inc(aBuffer, 3 * Counter.X.dir);
  6298. end;
  6299. 4: begin
  6300. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6301. inc(aBuffer, 4 * Counter.X.dir);
  6302. end;
  6303. end;
  6304. end;
  6305. var
  6306. TotalPixelsToRead, TotalPixelsRead: Integer;
  6307. Temp: Byte;
  6308. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6309. PixelRepeat: Boolean;
  6310. PixelsToRead, PixelCount: Integer;
  6311. begin
  6312. CacheSize := 0;
  6313. CachePos := 0;
  6314. TotalPixelsToRead := Header.Width * Header.Height;
  6315. TotalPixelsRead := 0;
  6316. LinePixelsRead := 0;
  6317. GetMem(Cache, CACHE_SIZE);
  6318. try
  6319. TmpData := ImageData;
  6320. inc(TmpData, Counter.Y.low * LineSize); //set line
  6321. if (Counter.X.dir < 0) then //if x flipped then
  6322. inc(TmpData, LineSize - PixelSize); //set last pixel
  6323. repeat
  6324. //read CommandByte
  6325. CachedRead(Temp, 1);
  6326. PixelRepeat := (Temp and $80) > 0;
  6327. PixelsToRead := (Temp and $7F) + 1;
  6328. inc(TotalPixelsRead, PixelsToRead);
  6329. if PixelRepeat then
  6330. CachedRead(buf[0], PixelSize);
  6331. while (PixelsToRead > 0) do begin
  6332. CheckLine;
  6333. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6334. while (PixelCount > 0) do begin
  6335. if not PixelRepeat then
  6336. CachedRead(buf[0], PixelSize);
  6337. PixelToBuffer(@buf[0], TmpData);
  6338. inc(LinePixelsRead);
  6339. dec(PixelsToRead);
  6340. dec(PixelCount);
  6341. end;
  6342. end;
  6343. until (TotalPixelsRead >= TotalPixelsToRead);
  6344. finally
  6345. FreeMem(Cache);
  6346. end;
  6347. end;
  6348. function IsGrayFormat: Boolean;
  6349. begin
  6350. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6351. end;
  6352. begin
  6353. result := false;
  6354. // reading header to test file and set cursor back to begin
  6355. StartPosition := aStream.Position;
  6356. aStream.Read(Header{%H-}, SizeOf(Header));
  6357. // no colormapped files
  6358. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6359. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6360. begin
  6361. try
  6362. if Header.ImageID <> 0 then // skip image ID
  6363. aStream.Position := aStream.Position + Header.ImageID;
  6364. tgaFormat := tfEmpty;
  6365. case Header.Bpp of
  6366. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6367. 0: tgaFormat := tfLuminance8;
  6368. 8: tgaFormat := tfAlpha8;
  6369. end;
  6370. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6371. 0: tgaFormat := tfLuminance16;
  6372. 8: tgaFormat := tfLuminance8Alpha8;
  6373. end else case (Header.ImageDesc and $F) of
  6374. 0: tgaFormat := tfBGR5;
  6375. 1: tgaFormat := tfBGR5A1;
  6376. 4: tgaFormat := tfBGRA4;
  6377. end;
  6378. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6379. 0: tgaFormat := tfBGR8;
  6380. end;
  6381. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6382. 2: tgaFormat := tfBGR10A2;
  6383. 8: tgaFormat := tfBGRA8;
  6384. end;
  6385. end;
  6386. if (tgaFormat = tfEmpty) then
  6387. raise EglBitmap.Create('LoadTga - unsupported format');
  6388. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6389. PixelSize := FormatDesc.GetSize(1, 1);
  6390. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6391. GetMem(ImageData, LineSize * Header.Height);
  6392. try
  6393. //column direction
  6394. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6395. Counter.X.low := Header.Height-1;;
  6396. Counter.X.high := 0;
  6397. Counter.X.dir := -1;
  6398. end else begin
  6399. Counter.X.low := 0;
  6400. Counter.X.high := Header.Height-1;
  6401. Counter.X.dir := 1;
  6402. end;
  6403. // Row direction
  6404. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6405. Counter.Y.low := 0;
  6406. Counter.Y.high := Header.Height-1;
  6407. Counter.Y.dir := 1;
  6408. end else begin
  6409. Counter.Y.low := Header.Height-1;;
  6410. Counter.Y.high := 0;
  6411. Counter.Y.dir := -1;
  6412. end;
  6413. // Read Image
  6414. case Header.ImageType of
  6415. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6416. ReadUncompressed;
  6417. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6418. ReadCompressed;
  6419. end;
  6420. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6421. result := true;
  6422. except
  6423. if Assigned(ImageData) then
  6424. FreeMem(ImageData);
  6425. raise;
  6426. end;
  6427. finally
  6428. aStream.Position := StartPosition;
  6429. end;
  6430. end
  6431. else aStream.Position := StartPosition;
  6432. end;
  6433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6434. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6435. var
  6436. Header: TTGAHeader;
  6437. LineSize, Size, x, y: Integer;
  6438. Pixel: TglBitmapPixelData;
  6439. LineBuf, SourceData, DestData: PByte;
  6440. SourceMD, DestMD: Pointer;
  6441. FormatDesc: TFormatDescriptor;
  6442. Converter: TFormatDescriptor;
  6443. begin
  6444. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6445. raise EglBitmapUnsupportedFormat.Create(Format);
  6446. //prepare header
  6447. FillChar(Header{%H-}, SizeOf(Header), 0);
  6448. //set ImageType
  6449. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6450. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6451. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6452. else
  6453. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6454. //set BitsPerPixel
  6455. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6456. Header.Bpp := 8
  6457. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6458. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6459. Header.Bpp := 16
  6460. else if (Format in [tfBGR8, tfRGB8]) then
  6461. Header.Bpp := 24
  6462. else
  6463. Header.Bpp := 32;
  6464. //set AlphaBitCount
  6465. case Format of
  6466. tfRGB5A1, tfBGR5A1:
  6467. Header.ImageDesc := 1 and $F;
  6468. tfRGB10A2, tfBGR10A2:
  6469. Header.ImageDesc := 2 and $F;
  6470. tfRGBA4, tfBGRA4:
  6471. Header.ImageDesc := 4 and $F;
  6472. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6473. Header.ImageDesc := 8 and $F;
  6474. end;
  6475. Header.Width := Width;
  6476. Header.Height := Height;
  6477. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6478. aStream.Write(Header, SizeOf(Header));
  6479. // convert RGB(A) to BGR(A)
  6480. Converter := nil;
  6481. FormatDesc := TFormatDescriptor.Get(Format);
  6482. Size := FormatDesc.GetSize(Dimension);
  6483. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6484. if (FormatDesc.RGBInverted = tfEmpty) then
  6485. raise EglBitmap.Create('inverted RGB format is empty');
  6486. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6487. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6488. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6489. raise EglBitmap.Create('invalid inverted RGB format');
  6490. end;
  6491. if Assigned(Converter) then begin
  6492. LineSize := FormatDesc.GetSize(Width, 1);
  6493. GetMem(LineBuf, LineSize);
  6494. SourceMD := FormatDesc.CreateMappingData;
  6495. DestMD := Converter.CreateMappingData;
  6496. try
  6497. SourceData := Data;
  6498. for y := 0 to Height-1 do begin
  6499. DestData := LineBuf;
  6500. for x := 0 to Width-1 do begin
  6501. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6502. Converter.Map(Pixel, DestData, DestMD);
  6503. end;
  6504. aStream.Write(LineBuf^, LineSize);
  6505. end;
  6506. finally
  6507. FreeMem(LineBuf);
  6508. FormatDesc.FreeMappingData(SourceMD);
  6509. FormatDesc.FreeMappingData(DestMD);
  6510. end;
  6511. end else
  6512. aStream.Write(Data^, Size);
  6513. end;
  6514. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6515. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6516. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6517. const
  6518. DDS_MAGIC: Cardinal = $20534444;
  6519. // DDS_header.dwFlags
  6520. DDSD_CAPS = $00000001;
  6521. DDSD_HEIGHT = $00000002;
  6522. DDSD_WIDTH = $00000004;
  6523. DDSD_PIXELFORMAT = $00001000;
  6524. // DDS_header.sPixelFormat.dwFlags
  6525. DDPF_ALPHAPIXELS = $00000001;
  6526. DDPF_ALPHA = $00000002;
  6527. DDPF_FOURCC = $00000004;
  6528. DDPF_RGB = $00000040;
  6529. DDPF_LUMINANCE = $00020000;
  6530. // DDS_header.sCaps.dwCaps1
  6531. DDSCAPS_TEXTURE = $00001000;
  6532. // DDS_header.sCaps.dwCaps2
  6533. DDSCAPS2_CUBEMAP = $00000200;
  6534. D3DFMT_DXT1 = $31545844;
  6535. D3DFMT_DXT3 = $33545844;
  6536. D3DFMT_DXT5 = $35545844;
  6537. type
  6538. TDDSPixelFormat = packed record
  6539. dwSize: Cardinal;
  6540. dwFlags: Cardinal;
  6541. dwFourCC: Cardinal;
  6542. dwRGBBitCount: Cardinal;
  6543. dwRBitMask: Cardinal;
  6544. dwGBitMask: Cardinal;
  6545. dwBBitMask: Cardinal;
  6546. dwABitMask: Cardinal;
  6547. end;
  6548. TDDSCaps = packed record
  6549. dwCaps1: Cardinal;
  6550. dwCaps2: Cardinal;
  6551. dwDDSX: Cardinal;
  6552. dwReserved: Cardinal;
  6553. end;
  6554. TDDSHeader = packed record
  6555. dwSize: Cardinal;
  6556. dwFlags: Cardinal;
  6557. dwHeight: Cardinal;
  6558. dwWidth: Cardinal;
  6559. dwPitchOrLinearSize: Cardinal;
  6560. dwDepth: Cardinal;
  6561. dwMipMapCount: Cardinal;
  6562. dwReserved: array[0..10] of Cardinal;
  6563. PixelFormat: TDDSPixelFormat;
  6564. Caps: TDDSCaps;
  6565. dwReserved2: Cardinal;
  6566. end;
  6567. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6568. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6569. var
  6570. Header: TDDSHeader;
  6571. Converter: TbmpBitfieldFormat;
  6572. function GetDDSFormat: TglBitmapFormat;
  6573. var
  6574. fd: TFormatDescriptor;
  6575. i: Integer;
  6576. Range: TglBitmapColorRec;
  6577. match: Boolean;
  6578. begin
  6579. result := tfEmpty;
  6580. with Header.PixelFormat do begin
  6581. // Compresses
  6582. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6583. case Header.PixelFormat.dwFourCC of
  6584. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6585. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6586. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6587. end;
  6588. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6589. //find matching format
  6590. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6591. fd := TFormatDescriptor.Get(result);
  6592. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6593. (8 * fd.PixelSize = dwRGBBitCount) then
  6594. exit;
  6595. end;
  6596. //find format with same Range
  6597. Range.r := dwRBitMask;
  6598. Range.g := dwGBitMask;
  6599. Range.b := dwBBitMask;
  6600. Range.a := dwABitMask;
  6601. for i := 0 to 3 do begin
  6602. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6603. Range.arr[i] := Range.arr[i] shr 1;
  6604. end;
  6605. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6606. fd := TFormatDescriptor.Get(result);
  6607. match := true;
  6608. for i := 0 to 3 do
  6609. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6610. match := false;
  6611. break;
  6612. end;
  6613. if match then
  6614. break;
  6615. end;
  6616. //no format with same range found -> use default
  6617. if (result = tfEmpty) then begin
  6618. if (dwABitMask > 0) then
  6619. result := tfBGRA8
  6620. else
  6621. result := tfBGR8;
  6622. end;
  6623. Converter := TbmpBitfieldFormat.Create;
  6624. Converter.RedMask := dwRBitMask;
  6625. Converter.GreenMask := dwGBitMask;
  6626. Converter.BlueMask := dwBBitMask;
  6627. Converter.AlphaMask := dwABitMask;
  6628. Converter.PixelSize := dwRGBBitCount / 8;
  6629. end;
  6630. end;
  6631. end;
  6632. var
  6633. StreamPos: Int64;
  6634. x, y, LineSize, RowSize, Magic: Cardinal;
  6635. NewImage, TmpData, RowData, SrcData: System.PByte;
  6636. SourceMD, DestMD: Pointer;
  6637. Pixel: TglBitmapPixelData;
  6638. ddsFormat: TglBitmapFormat;
  6639. FormatDesc: TFormatDescriptor;
  6640. begin
  6641. result := false;
  6642. Converter := nil;
  6643. StreamPos := aStream.Position;
  6644. // Magic
  6645. aStream.Read(Magic{%H-}, sizeof(Magic));
  6646. if (Magic <> DDS_MAGIC) then begin
  6647. aStream.Position := StreamPos;
  6648. exit;
  6649. end;
  6650. //Header
  6651. aStream.Read(Header{%H-}, sizeof(Header));
  6652. if (Header.dwSize <> SizeOf(Header)) or
  6653. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6654. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6655. begin
  6656. aStream.Position := StreamPos;
  6657. exit;
  6658. end;
  6659. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6660. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  6661. ddsFormat := GetDDSFormat;
  6662. try
  6663. if (ddsFormat = tfEmpty) then
  6664. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6665. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6666. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6667. GetMem(NewImage, Header.dwHeight * LineSize);
  6668. try
  6669. TmpData := NewImage;
  6670. //Converter needed
  6671. if Assigned(Converter) then begin
  6672. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6673. GetMem(RowData, RowSize);
  6674. SourceMD := Converter.CreateMappingData;
  6675. DestMD := FormatDesc.CreateMappingData;
  6676. try
  6677. for y := 0 to Header.dwHeight-1 do begin
  6678. TmpData := NewImage;
  6679. inc(TmpData, y * LineSize);
  6680. SrcData := RowData;
  6681. aStream.Read(SrcData^, RowSize);
  6682. for x := 0 to Header.dwWidth-1 do begin
  6683. Converter.Unmap(SrcData, Pixel, SourceMD);
  6684. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6685. FormatDesc.Map(Pixel, TmpData, DestMD);
  6686. end;
  6687. end;
  6688. finally
  6689. Converter.FreeMappingData(SourceMD);
  6690. FormatDesc.FreeMappingData(DestMD);
  6691. FreeMem(RowData);
  6692. end;
  6693. end else
  6694. // Compressed
  6695. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6696. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6697. for Y := 0 to Header.dwHeight-1 do begin
  6698. aStream.Read(TmpData^, RowSize);
  6699. Inc(TmpData, LineSize);
  6700. end;
  6701. end else
  6702. // Uncompressed
  6703. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6704. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6705. for Y := 0 to Header.dwHeight-1 do begin
  6706. aStream.Read(TmpData^, RowSize);
  6707. Inc(TmpData, LineSize);
  6708. end;
  6709. end else
  6710. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6711. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  6712. result := true;
  6713. except
  6714. if Assigned(NewImage) then
  6715. FreeMem(NewImage);
  6716. raise;
  6717. end;
  6718. finally
  6719. FreeAndNil(Converter);
  6720. end;
  6721. end;
  6722. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6723. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6724. var
  6725. Header: TDDSHeader;
  6726. FormatDesc: TFormatDescriptor;
  6727. begin
  6728. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6729. raise EglBitmapUnsupportedFormat.Create(Format);
  6730. FormatDesc := TFormatDescriptor.Get(Format);
  6731. // Generell
  6732. FillChar(Header{%H-}, SizeOf(Header), 0);
  6733. Header.dwSize := SizeOf(Header);
  6734. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6735. Header.dwWidth := Max(1, Width);
  6736. Header.dwHeight := Max(1, Height);
  6737. // Caps
  6738. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6739. // Pixelformat
  6740. Header.PixelFormat.dwSize := sizeof(Header);
  6741. if (FormatDesc.IsCompressed) then begin
  6742. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6743. case Format of
  6744. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6745. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6746. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6747. end;
  6748. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6749. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6750. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6751. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6752. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6753. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6754. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6755. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6756. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6757. end else begin
  6758. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6759. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6760. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6761. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6762. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6763. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6764. end;
  6765. if (FormatDesc.HasAlpha) then
  6766. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6767. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6768. aStream.Write(Header, SizeOf(Header));
  6769. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6770. end;
  6771. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6772. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6773. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6774. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6775. const aWidth: Integer; const aHeight: Integer);
  6776. var
  6777. pTemp: pByte;
  6778. Size: Integer;
  6779. begin
  6780. if (aHeight > 1) then begin
  6781. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  6782. GetMem(pTemp, Size);
  6783. try
  6784. Move(aData^, pTemp^, Size);
  6785. FreeMem(aData);
  6786. aData := nil;
  6787. except
  6788. FreeMem(pTemp);
  6789. raise;
  6790. end;
  6791. end else
  6792. pTemp := aData;
  6793. inherited SetDataPointer(pTemp, aFormat, aWidth);
  6794. end;
  6795. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6796. function TglBitmap1D.FlipHorz: Boolean;
  6797. var
  6798. Col: Integer;
  6799. pTempDest, pDest, pSource: PByte;
  6800. begin
  6801. result := inherited FlipHorz;
  6802. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  6803. pSource := Data;
  6804. GetMem(pDest, fRowSize);
  6805. try
  6806. pTempDest := pDest;
  6807. Inc(pTempDest, fRowSize);
  6808. for Col := 0 to Width-1 do begin
  6809. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  6810. Move(pSource^, pTempDest^, fPixelSize);
  6811. Inc(pSource, fPixelSize);
  6812. end;
  6813. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  6814. result := true;
  6815. except
  6816. if Assigned(pDest) then
  6817. FreeMem(pDest);
  6818. raise;
  6819. end;
  6820. end;
  6821. end;
  6822. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6823. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  6824. var
  6825. FormatDesc: TFormatDescriptor;
  6826. begin
  6827. // Upload data
  6828. FormatDesc := TFormatDescriptor.Get(Format);
  6829. if FormatDesc.IsCompressed then
  6830. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  6831. else if aBuildWithGlu then
  6832. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6833. else
  6834. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6835. // Free Data
  6836. if (FreeDataAfterGenTexture) then
  6837. FreeData;
  6838. end;
  6839. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6840. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  6841. var
  6842. BuildWithGlu, TexRec: Boolean;
  6843. TexSize: Integer;
  6844. begin
  6845. if Assigned(Data) then begin
  6846. // Check Texture Size
  6847. if (aTestTextureSize) then begin
  6848. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6849. if (Width > TexSize) then
  6850. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6851. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6852. (Target = GL_TEXTURE_RECTANGLE);
  6853. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6854. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6855. end;
  6856. CreateId;
  6857. SetupParameters(BuildWithGlu);
  6858. UploadData(BuildWithGlu);
  6859. glAreTexturesResident(1, @fID, @fIsResident);
  6860. end;
  6861. end;
  6862. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6863. procedure TglBitmap1D.AfterConstruction;
  6864. begin
  6865. inherited;
  6866. Target := GL_TEXTURE_1D;
  6867. end;
  6868. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6869. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6870. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6871. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6872. begin
  6873. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6874. result := fLines[aIndex]
  6875. else
  6876. result := nil;
  6877. end;
  6878. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6879. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6880. const aWidth: Integer; const aHeight: Integer);
  6881. var
  6882. Idx, LineWidth: Integer;
  6883. begin
  6884. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6885. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6886. // Assigning Data
  6887. if Assigned(Data) then begin
  6888. SetLength(fLines, GetHeight);
  6889. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6890. for Idx := 0 to GetHeight-1 do begin
  6891. fLines[Idx] := Data;
  6892. Inc(fLines[Idx], Idx * LineWidth);
  6893. end;
  6894. end
  6895. else SetLength(fLines, 0);
  6896. end else begin
  6897. SetLength(fLines, 0);
  6898. end;
  6899. end;
  6900. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6901. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  6902. var
  6903. FormatDesc: TFormatDescriptor;
  6904. begin
  6905. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6906. FormatDesc := TFormatDescriptor.Get(Format);
  6907. if FormatDesc.IsCompressed then begin
  6908. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  6909. end else if aBuildWithGlu then begin
  6910. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  6911. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6912. end else begin
  6913. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  6914. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6915. end;
  6916. // Freigeben
  6917. if (FreeDataAfterGenTexture) then
  6918. FreeData;
  6919. end;
  6920. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6921. procedure TglBitmap2D.AfterConstruction;
  6922. begin
  6923. inherited;
  6924. Target := GL_TEXTURE_2D;
  6925. end;
  6926. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6927. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  6928. var
  6929. Temp: pByte;
  6930. Size, w, h: Integer;
  6931. FormatDesc: TFormatDescriptor;
  6932. begin
  6933. FormatDesc := TFormatDescriptor.Get(aFormat);
  6934. if FormatDesc.IsCompressed then
  6935. raise EglBitmapUnsupportedFormat.Create(aFormat);
  6936. w := aRight - aLeft;
  6937. h := aBottom - aTop;
  6938. Size := FormatDesc.GetSize(w, h);
  6939. GetMem(Temp, Size);
  6940. try
  6941. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  6942. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  6943. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  6944. FlipVert;
  6945. except
  6946. if Assigned(Temp) then
  6947. FreeMem(Temp);
  6948. raise;
  6949. end;
  6950. end;
  6951. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6952. procedure TglBitmap2D.GetDataFromTexture;
  6953. var
  6954. Temp: PByte;
  6955. TempWidth, TempHeight: Integer;
  6956. TempIntFormat: Cardinal;
  6957. IntFormat, f: TglBitmapFormat;
  6958. FormatDesc: TFormatDescriptor;
  6959. begin
  6960. Bind;
  6961. // Request Data
  6962. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  6963. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  6964. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  6965. IntFormat := tfEmpty;
  6966. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  6967. FormatDesc := TFormatDescriptor.Get(f);
  6968. if (FormatDesc.glInternalFormat = TempIntFormat) then begin
  6969. IntFormat := FormatDesc.Format;
  6970. break;
  6971. end;
  6972. end;
  6973. // Getting data from OpenGL
  6974. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6975. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  6976. try
  6977. if FormatDesc.IsCompressed then
  6978. glGetCompressedTexImage(Target, 0, Temp)
  6979. else
  6980. glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
  6981. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  6982. except
  6983. if Assigned(Temp) then
  6984. FreeMem(Temp);
  6985. raise;
  6986. end;
  6987. end;
  6988. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6989. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  6990. var
  6991. BuildWithGlu, PotTex, TexRec: Boolean;
  6992. TexSize: Integer;
  6993. begin
  6994. if Assigned(Data) then begin
  6995. // Check Texture Size
  6996. if (aTestTextureSize) then begin
  6997. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6998. if ((Height > TexSize) or (Width > TexSize)) then
  6999. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7000. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7001. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7002. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7003. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7004. end;
  7005. CreateId;
  7006. SetupParameters(BuildWithGlu);
  7007. UploadData(Target, BuildWithGlu);
  7008. glAreTexturesResident(1, @fID, @fIsResident);
  7009. end;
  7010. end;
  7011. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7012. function TglBitmap2D.FlipHorz: Boolean;
  7013. var
  7014. Col, Row: Integer;
  7015. TempDestData, DestData, SourceData: PByte;
  7016. ImgSize: Integer;
  7017. begin
  7018. result := inherited FlipHorz;
  7019. if Assigned(Data) then begin
  7020. SourceData := Data;
  7021. ImgSize := Height * fRowSize;
  7022. GetMem(DestData, ImgSize);
  7023. try
  7024. TempDestData := DestData;
  7025. Dec(TempDestData, fRowSize + fPixelSize);
  7026. for Row := 0 to Height -1 do begin
  7027. Inc(TempDestData, fRowSize * 2);
  7028. for Col := 0 to Width -1 do begin
  7029. Move(SourceData^, TempDestData^, fPixelSize);
  7030. Inc(SourceData, fPixelSize);
  7031. Dec(TempDestData, fPixelSize);
  7032. end;
  7033. end;
  7034. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  7035. result := true;
  7036. except
  7037. if Assigned(DestData) then
  7038. FreeMem(DestData);
  7039. raise;
  7040. end;
  7041. end;
  7042. end;
  7043. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7044. function TglBitmap2D.FlipVert: Boolean;
  7045. var
  7046. Row: Integer;
  7047. TempDestData, DestData, SourceData: PByte;
  7048. begin
  7049. result := inherited FlipVert;
  7050. if Assigned(Data) then begin
  7051. SourceData := Data;
  7052. GetMem(DestData, Height * fRowSize);
  7053. try
  7054. TempDestData := DestData;
  7055. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7056. for Row := 0 to Height -1 do begin
  7057. Move(SourceData^, TempDestData^, fRowSize);
  7058. Dec(TempDestData, fRowSize);
  7059. Inc(SourceData, fRowSize);
  7060. end;
  7061. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  7062. result := true;
  7063. except
  7064. if Assigned(DestData) then
  7065. FreeMem(DestData);
  7066. raise;
  7067. end;
  7068. end;
  7069. end;
  7070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7071. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7072. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7073. type
  7074. TMatrixItem = record
  7075. X, Y: Integer;
  7076. W: Single;
  7077. end;
  7078. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7079. TglBitmapToNormalMapRec = Record
  7080. Scale: Single;
  7081. Heights: array of Single;
  7082. MatrixU : array of TMatrixItem;
  7083. MatrixV : array of TMatrixItem;
  7084. end;
  7085. const
  7086. ONE_OVER_255 = 1 / 255;
  7087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7088. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7089. var
  7090. Val: Single;
  7091. begin
  7092. with FuncRec do begin
  7093. Val :=
  7094. Source.Data.r * LUMINANCE_WEIGHT_R +
  7095. Source.Data.g * LUMINANCE_WEIGHT_G +
  7096. Source.Data.b * LUMINANCE_WEIGHT_B;
  7097. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7098. end;
  7099. end;
  7100. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7101. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7102. begin
  7103. with FuncRec do
  7104. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7105. end;
  7106. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7107. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7108. type
  7109. TVec = Array[0..2] of Single;
  7110. var
  7111. Idx: Integer;
  7112. du, dv: Double;
  7113. Len: Single;
  7114. Vec: TVec;
  7115. function GetHeight(X, Y: Integer): Single;
  7116. begin
  7117. with FuncRec do begin
  7118. X := Max(0, Min(Size.X -1, X));
  7119. Y := Max(0, Min(Size.Y -1, Y));
  7120. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7121. end;
  7122. end;
  7123. begin
  7124. with FuncRec do begin
  7125. with PglBitmapToNormalMapRec(Args)^ do begin
  7126. du := 0;
  7127. for Idx := Low(MatrixU) to High(MatrixU) do
  7128. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7129. dv := 0;
  7130. for Idx := Low(MatrixU) to High(MatrixU) do
  7131. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7132. Vec[0] := -du * Scale;
  7133. Vec[1] := -dv * Scale;
  7134. Vec[2] := 1;
  7135. end;
  7136. // Normalize
  7137. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7138. if Len <> 0 then begin
  7139. Vec[0] := Vec[0] * Len;
  7140. Vec[1] := Vec[1] * Len;
  7141. Vec[2] := Vec[2] * Len;
  7142. end;
  7143. // Farbe zuweisem
  7144. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7145. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7146. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7147. end;
  7148. end;
  7149. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7150. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7151. var
  7152. Rec: TglBitmapToNormalMapRec;
  7153. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7154. begin
  7155. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7156. Matrix[Index].X := X;
  7157. Matrix[Index].Y := Y;
  7158. Matrix[Index].W := W;
  7159. end;
  7160. end;
  7161. begin
  7162. if TFormatDescriptor.Get(Format).IsCompressed then
  7163. raise EglBitmapUnsupportedFormat.Create(Format);
  7164. if aScale > 100 then
  7165. Rec.Scale := 100
  7166. else if aScale < -100 then
  7167. Rec.Scale := -100
  7168. else
  7169. Rec.Scale := aScale;
  7170. SetLength(Rec.Heights, Width * Height);
  7171. try
  7172. case aFunc of
  7173. nm4Samples: begin
  7174. SetLength(Rec.MatrixU, 2);
  7175. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7176. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7177. SetLength(Rec.MatrixV, 2);
  7178. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7179. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7180. end;
  7181. nmSobel: begin
  7182. SetLength(Rec.MatrixU, 6);
  7183. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7184. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7185. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7186. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7187. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7188. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7189. SetLength(Rec.MatrixV, 6);
  7190. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7191. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7192. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7193. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7194. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7195. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7196. end;
  7197. nm3x3: begin
  7198. SetLength(Rec.MatrixU, 6);
  7199. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7200. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7201. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7202. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7203. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7204. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7205. SetLength(Rec.MatrixV, 6);
  7206. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7207. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7208. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7209. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7210. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7211. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7212. end;
  7213. nm5x5: begin
  7214. SetLength(Rec.MatrixU, 20);
  7215. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7216. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7217. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7218. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7219. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7220. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7221. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7222. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7223. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7224. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7225. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7226. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7227. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7228. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7229. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7230. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7231. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7232. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7233. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7234. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7235. SetLength(Rec.MatrixV, 20);
  7236. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7237. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7238. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7239. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7240. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7241. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7242. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7243. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7244. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7245. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7246. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7247. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7248. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7249. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7250. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7251. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7252. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7253. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7254. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7255. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7256. end;
  7257. end;
  7258. // Daten Sammeln
  7259. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7260. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7261. else
  7262. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7263. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7264. finally
  7265. SetLength(Rec.Heights, 0);
  7266. end;
  7267. end;
  7268. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7269. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7270. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7271. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7272. begin
  7273. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7274. end;
  7275. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7276. procedure TglBitmapCubeMap.AfterConstruction;
  7277. begin
  7278. inherited;
  7279. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7280. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7281. SetWrap;
  7282. Target := GL_TEXTURE_CUBE_MAP;
  7283. fGenMode := GL_REFLECTION_MAP;
  7284. end;
  7285. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7286. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7287. var
  7288. BuildWithGlu: Boolean;
  7289. TexSize: Integer;
  7290. begin
  7291. if (aTestTextureSize) then begin
  7292. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7293. if (Height > TexSize) or (Width > TexSize) then
  7294. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7295. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7296. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7297. end;
  7298. if (ID = 0) then
  7299. CreateID;
  7300. SetupParameters(BuildWithGlu);
  7301. UploadData(aCubeTarget, BuildWithGlu);
  7302. end;
  7303. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7304. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
  7305. begin
  7306. inherited Bind (aEnableTextureUnit);
  7307. if aEnableTexCoordsGen then begin
  7308. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7309. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7310. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7311. glEnable(GL_TEXTURE_GEN_S);
  7312. glEnable(GL_TEXTURE_GEN_T);
  7313. glEnable(GL_TEXTURE_GEN_R);
  7314. end;
  7315. end;
  7316. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7317. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
  7318. begin
  7319. inherited Unbind(aDisableTextureUnit);
  7320. if aDisableTexCoordsGen then begin
  7321. glDisable(GL_TEXTURE_GEN_S);
  7322. glDisable(GL_TEXTURE_GEN_T);
  7323. glDisable(GL_TEXTURE_GEN_R);
  7324. end;
  7325. end;
  7326. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7327. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7328. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7329. type
  7330. TVec = Array[0..2] of Single;
  7331. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7332. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7333. TglBitmapNormalMapRec = record
  7334. HalfSize : Integer;
  7335. Func: TglBitmapNormalMapGetVectorFunc;
  7336. end;
  7337. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7338. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7339. begin
  7340. aVec[0] := aHalfSize;
  7341. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7342. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7343. end;
  7344. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7345. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7346. begin
  7347. aVec[0] := - aHalfSize;
  7348. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7349. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7350. end;
  7351. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7352. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7353. begin
  7354. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7355. aVec[1] := aHalfSize;
  7356. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7357. end;
  7358. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7359. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7360. begin
  7361. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7362. aVec[1] := - aHalfSize;
  7363. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7364. end;
  7365. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7366. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7367. begin
  7368. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7369. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7370. aVec[2] := aHalfSize;
  7371. end;
  7372. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7373. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7374. begin
  7375. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7376. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7377. aVec[2] := - aHalfSize;
  7378. end;
  7379. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7380. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7381. var
  7382. i: Integer;
  7383. Vec: TVec;
  7384. Len: Single;
  7385. begin
  7386. with FuncRec do begin
  7387. with PglBitmapNormalMapRec(Args)^ do begin
  7388. Func(Vec, Position, HalfSize);
  7389. // Normalize
  7390. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7391. if Len <> 0 then begin
  7392. Vec[0] := Vec[0] * Len;
  7393. Vec[1] := Vec[1] * Len;
  7394. Vec[2] := Vec[2] * Len;
  7395. end;
  7396. // Scale Vector and AddVectro
  7397. Vec[0] := Vec[0] * 0.5 + 0.5;
  7398. Vec[1] := Vec[1] * 0.5 + 0.5;
  7399. Vec[2] := Vec[2] * 0.5 + 0.5;
  7400. end;
  7401. // Set Color
  7402. for i := 0 to 2 do
  7403. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7404. end;
  7405. end;
  7406. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7407. procedure TglBitmapNormalMap.AfterConstruction;
  7408. begin
  7409. inherited;
  7410. fGenMode := GL_NORMAL_MAP;
  7411. end;
  7412. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7413. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7414. var
  7415. Rec: TglBitmapNormalMapRec;
  7416. SizeRec: TglBitmapPixelPosition;
  7417. begin
  7418. Rec.HalfSize := aSize div 2;
  7419. FreeDataAfterGenTexture := false;
  7420. SizeRec.Fields := [ffX, ffY];
  7421. SizeRec.X := aSize;
  7422. SizeRec.Y := aSize;
  7423. // Positive X
  7424. Rec.Func := glBitmapNormalMapPosX;
  7425. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7426. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7427. // Negative X
  7428. Rec.Func := glBitmapNormalMapNegX;
  7429. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7430. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7431. // Positive Y
  7432. Rec.Func := glBitmapNormalMapPosY;
  7433. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7434. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7435. // Negative Y
  7436. Rec.Func := glBitmapNormalMapNegY;
  7437. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7438. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7439. // Positive Z
  7440. Rec.Func := glBitmapNormalMapPosZ;
  7441. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7442. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7443. // Negative Z
  7444. Rec.Func := glBitmapNormalMapNegZ;
  7445. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7446. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7447. end;
  7448. initialization
  7449. glBitmapSetDefaultFormat (tfEmpty);
  7450. glBitmapSetDefaultMipmap (mmMipmap);
  7451. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7452. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7453. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7454. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7455. glBitmapSetDefaultDeleteTextureOnFree (true);
  7456. TFormatDescriptor.Init;
  7457. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7458. OpenGLInitialized := false;
  7459. InitOpenGLCS := TCriticalSection.Create;
  7460. {$ENDIF}
  7461. finalization
  7462. TFormatDescriptor.Finalize;
  7463. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7464. FreeAndNil(InitOpenGLCS);
  7465. {$ENDIF}
  7466. end.